(in-package "SB-PCL")
\f
-
(defun make-progn (&rest forms)
(let ((progn-form nil))
(labels ((collect-forms (forms)
(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
(fix-super (car supers)))
(and (not (eq name 'structure-object))
*the-class-structure-object*)))
- (defstruct-form (make-structure-class-defstruct-form name
- slots
- include)))
+ (defstruct-form (make-structure-class-defstruct-form
+ name slots include)))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
,defstruct-form) ; really compile the defstruct-form
(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))