0.7.1.2:
[sbcl.git] / src / pcl / defclass.lisp
index 5f04c28..ba280ee 100644 (file)
@@ -23,7 +23,6 @@
 
 (in-package "SB-PCL")
 \f
-
 (defun make-progn (&rest forms)
   (let ((progn-form nil))
     (labels ((collect-forms (forms)
@@ -53,7 +52,7 @@
       (dolist (option options)
         (if (not (listp option))
          (error "~S is not a legal defclass option." option)
-         (when (eq (car option) ':metaclass)
+         (when (eq (car option) :metaclass)
            (unless (legal-class-name-p (cadr option))
              (error "The value of the :metaclass option (~S) is not a~%~
                      legal class name."
             (*writers* ()))             ;to have it to live nicely.
         (declare (special *initfunctions* *readers* *writers*))
         (let ((canonical-slots
-                (mapcar #'(lambda (spec)
-                            (canonicalize-slot-specification name spec))
+                (mapcar (lambda (spec)
+                         (canonicalize-slot-specification name spec))
                         slots))
               (other-initargs
-                (mapcar #'(lambda (option)
-                            (canonicalize-defclass-option name option))
+                (mapcar (lambda (option)
+                         (canonicalize-defclass-option name option))
                         options))
               ;; DEFSTRUCT-P should be true, if the class is defined with a
               ;; metaclass STRUCTURE-CLASS, such that a DEFSTRUCT is compiled
                (setq key (pop tail)
                      val (pop tail))
                (push ``(,',key ,,(make-initfunction val) ,',val) canonical))
-         `(':direct-default-initargs (list ,@(nreverse canonical))))))
+         `(:direct-default-initargs (list ,@(nreverse canonical))))))
     (:documentation
       `(',(car option) ',(cadr option)))
     (otherwise
     (values (early-collect-slots cpl)
            cpl
            (early-collect-default-initargs cpl)
-           (gathering1 (collecting)
+           (let (collect)
              (dolist (definition *early-class-definitions*)
                (when (memq class-name (ecd-superclass-names definition))
-                 (gather1 (ecd-class-name definition))))))))
+                 (push (ecd-class-name definition) collect)))
+              (nreverse collect)))))
 
 (defun early-collect-slots (cpl)
   (let* ((definitions (mapcar #'early-class-definition cpl))