0.7.12.38:

[sbcl.git] / src / code / early-extensions.lisp

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 58a2de9..323982d 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -626,11 +626,24 @@
 (defun legal-fun-name-p (name)
   (or (symbolp name)
       (and (consp name)
-           (or (eq (car name) 'setf)
-              (eq (car name) 'sb!pcl::class-predicate))
-           (consp (cdr name))
-           (symbolp (cadr name))
-           (null (cddr 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)
@@ -655,7 +668,9 @@
         fun-name)
        ((and (consp fun-name)
              (legal-fun-name-p fun-name))
-        (second fun-name))
+        (case (car fun-name)
+          ((setf sb!pcl::class-predicate) (second fun-name))
+          ((sb!pcl::slot-accessor) (third fun-name))))
        (t
         (error "not legal as a function name: ~S" fun-name))))