projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.7.1.2:
[sbcl.git]
/
src
/
pcl
/
defclass.lisp
diff --git
a/src/pcl/defclass.lisp
b/src/pcl/defclass.lisp
index
5f04c28
..
ba280ee
100644
(file)
--- a/
src/pcl/defclass.lisp
+++ b/
src/pcl/defclass.lisp
@@
-23,7
+23,6
@@
(in-package "SB-PCL")
\f
(in-package "SB-PCL")
\f
-
(defun make-progn (&rest forms)
(let ((progn-form nil))
(labels ((collect-forms (forms)
(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)
(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."
(unless (legal-class-name-p (cadr option))
(error "The value of the :metaclass option (~S) is not a~%~
legal class name."
@@
-71,12
+70,12
@@
(*writers* ())) ;to have it to live nicely.
(declare (special *initfunctions* *readers* *writers*))
(let ((canonical-slots
(*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
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
options))
;; DEFSTRUCT-P should be true, if the class is defined with a
;; metaclass STRUCTURE-CLASS, such that a DEFSTRUCT is compiled
@@
-221,7
+220,7
@@
(setq key (pop tail)
val (pop tail))
(push ``(,',key ,,(make-initfunction val) ,',val) canonical))
(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
(:documentation
`(',(car option) ',(cadr option)))
(otherwise
@@
-274,10
+273,11
@@
(values (early-collect-slots cpl)
cpl
(early-collect-default-initargs cpl)
(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))
(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))
(defun early-collect-slots (cpl)
(let* ((definitions (mapcar #'early-class-definition cpl))