- (eq (car name) 'setf)
- (consp (cdr name))
- (symbolp (cadr name))
- (null (cddr name)))))
-
-;;; Given a function name, return the name for the BLOCK which
-;;; encloses its body (e.g. in DEFUN, DEFINE-COMPILER-MACRO, or FLET).
-(declaim (ftype (function ((or symbol cons)) symbol) function-name-block-name))
-(defun function-name-block-name (function-name)
- (cond ((symbolp function-name)
- function-name)
- ((and (consp function-name)
- (= (length function-name) 2)
- (eq (first function-name) 'setf))
- (second function-name))
+ ;; (SETF FOO)
+ ;; (CLASS-PREDICATE FOO)
+ (or (and (or (eq (car name) 'setf)
+ (eq (car name) 'sb!pcl::class-predicate))
+ (consp (cdr name))
+ (symbolp (cadr name))
+ (null (cddr name)))
+ ;; (SLOT-ACCESSOR <CLASSNAME-OR-:GLOBAL>
+ ;; <SLOT-NAME> [READER|WRITER|BOUNDP])
+ (and (eq (car name) 'sb!pcl::slot-accessor)
+ (consp (cdr name))
+ (symbolp (cadr name))
+ (consp (cddr name))
+ (symbolp (caddr name))
+ (consp (cdddr name))
+ (member
+ (cadddr name)
+ '(sb!pcl::reader sb!pcl::writer sb!pcl::boundp)))))))
+
+;;; Signal an error unless NAME is a legal function name.
+(defun legal-fun-name-or-type-error (name)
+ (unless (legal-fun-name-p name)
+ (error 'simple-type-error
+ :datum name
+ :expected-type '(or symbol list)
+ :format-control "invalid function name: ~S"
+ :format-arguments (list name))))
+
+;;; Given a function name, return the symbol embedded in it.
+;;;
+;;; The ordinary use for this operator (and the motivation for the
+;;; name of this operator) is to convert from a function name to the
+;;; name of the BLOCK which encloses its body.
+;;;
+;;; Occasionally the operator is useful elsewhere, where the operator
+;;; name is less mnemonic. (Maybe it should be changed?)
+(declaim (ftype (function ((or symbol cons)) symbol) fun-name-block-name))
+(defun fun-name-block-name (fun-name)
+ (cond ((symbolp fun-name)
+ fun-name)
+ ((and (consp fun-name)
+ (legal-fun-name-p fun-name))
+ (case (car fun-name)
+ ((setf sb!pcl::class-predicate) (second fun-name))
+ ((sb!pcl::slot-accessor) (third fun-name))))