(set-slot 'direct-subclasses (classes direct-subclasses))
(set-slot 'direct-methods (cons nil nil))
(set-slot 'wrapper wrapper)
- (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*))
- (make-class-predicate-name name)))
(set-slot 'documentation nil)
(set-slot 'plist
`(,@(and direct-default-initargs
(case metaclass-name
(structure-class
(let ((constructor-sym '|STRUCTURE-OBJECT class constructor|))
- (set-slot 'predicate-name (or (cadr (assoc name
- *early-class-predicates*))
- (make-class-predicate-name name)))
(set-slot 'defstruct-form
`(defstruct (structure-object (:constructor
,constructor-sym)
slot-name
readers
writers
- nil)
- (!bootstrap-accessor-definitions1
- 'slot-object
- slot-name
- (list (slot-reader-name slot-name))
- (list (slot-writer-name slot-name))
- (list (slot-boundp-name slot-name)))))))))))
+ nil)))))))))
(defun !bootstrap-accessor-definition (class-name accessor-name slot-name type)
(multiple-value-bind (accessor-class make-method-function arglist specls doc)
(dolist (writer writers) (do-writer-definition writer))
(dolist (boundp boundps) (do-boundp-definition boundp))))
+;;; FIXME: find a better name.
(defun !bootstrap-class-predicates (early-p)
(let ((*early-p* early-p))
- (dolist (definition *early-class-definitions*)
- (let* ((name (ecd-class-name definition))
- (class (find-class name)))
- (setf (find-class-predicate name)
- (make-class-predicate class (class-predicate-name class)))))))
+ (dolist (ecp *early-class-predicates*)
+ (let ((class-name (car ecp))
+ (predicate-name (cadr ecp)))
+ (make-class-predicate (find-class class-name) predicate-name)))))
(defun !bootstrap-built-in-classes ()
name class-eq-wrapper nil
supers subs
(cons name cpl)
- wrapper prototype)))))
-
- (dolist (e *built-in-classes*)
- (let* ((name (car e))
- (class (find-class name)))
- (setf (find-class-predicate name)
- (make-class-predicate class (class-predicate-name class))))))
+ wrapper prototype))))))
\f
(defmacro wrapper-of-macro (x)
`(layout-of ,x))
(t
(error "~@<~S is not the name of a class.~@:>" name)))))
-(defun ensure-defstruct-class (classoid)
+(defun ensure-deffoo-class (classoid)
(let ((class (classoid-pcl-class classoid)))
(cond (class
(ensure-non-standard-class (class-name class) class))
((eq 'complete *boot-state*)
(ensure-non-standard-class (classoid-name classoid))))))
-(pushnew 'ensure-defstruct-class sb-kernel::*defstruct-hooks*)
+(pushnew 'ensure-deffoo-class sb-kernel::*defstruct-hooks*)
+(pushnew 'ensure-deffoo-class sb-kernel::*define-condition-hooks*)
\f
(defun make-class-predicate (class name)
(let* ((gf (ensure-generic-function name :lambda-list '(object)))