X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fbraid.lisp;h=4cf786bdef005381f394ac90d4d7ff5d087baf95;hb=4e0e251d6dca596ad8f3da81c1b582e3887b3c98;hp=9983c49f8af2eed67a67771a2551ab5d1e38578d;hpb=88e9e177e7ca72d660a3335d63895a1e0f71a5f8;p=sbcl.git diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 9983c49..4cf786b 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -288,8 +288,6 @@ (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 @@ -320,9 +318,6 @@ (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) @@ -404,13 +399,7 @@ 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) @@ -471,13 +460,13 @@ (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 () @@ -516,13 +505,7 @@ 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)))))) (defmacro wrapper-of-macro (x) `(layout-of ,x))