(dolist (definition *early-class-definitions*)
(let ((name (ecd-class-name definition))
(meta (ecd-metaclass definition))
- (source (ecd-source definition))
+ (source (ecd-source-location definition))
(direct-supers (ecd-superclass-names definition))
(direct-slots (ecd-canonical-slots definition))
(other-initargs (ecd-other-initargs definition)))
smc
name
value)))
- (set-slot 'source *load-pathname*)
+ (set-slot 'source nil)
(set-slot 'type 'standard)
(set-slot 'documentation "The standard method combination.")
(set-slot 'options ()))
(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)
(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)))