X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=d40e7cfbef23971265aea2f003cc344141791f69;hb=96a67b487909638cc0cb91114b6babf94b4bc1a7;hp=d00336481c232fa68115949309736d286bef3798;hpb=942e45e3bb73fd55786e4a0ab4590324063c0c89;p=sbcl.git diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index d003364..d40e7cf 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -73,10 +73,6 @@ effective-slot-definition)) (let* ((name (slot-value slotd 'name)) (class (slot-value slotd '%class))) - (let ((table (or (gethash name *name->class->slotd-table*) - (setf (gethash name *name->class->slotd-table*) - (make-hash-table :test 'eq :size 5))))) - (setf (gethash class table) slotd)) (dolist (type '(reader writer boundp)) (let* ((gf-name (ecase type (reader 'slot-value-using-class) @@ -280,11 +276,11 @@ slot-names &key) (declare (ignore slot-names)) - (setf (slot-value specl 'type) `(class-eq ,(specializer-class specl)))) + (setf (slot-value specl '%type) `(class-eq ,(specializer-class specl)))) (defmethod shared-initialize :after ((specl eql-specializer) slot-names &key) (declare (ignore slot-names)) - (setf (slot-value specl 'type) + (setf (slot-value specl '%type) `(eql ,(specializer-object specl))) (setf (info :type :translator specl) (constantly (make-member-type :members (list (specializer-object specl)))))) @@ -484,7 +480,7 @@ (declare (ignore slot-names name)) ;; FIXME: Could this just be CLASS instead of `(CLASS ,CLASS)? If not, ;; why not? (See also similar expression in !BOOTSTRAP-INITIALIZE-CLASS.) - (setf (slot-value class 'type) `(class ,class)) + (setf (slot-value class '%type) `(class ,class)) (setf (slot-value class 'class-eq-specializer) (make-instance 'class-eq-specializer :class class))) @@ -812,9 +808,8 @@ (update-gfs-of-class class) (update-initargs class (compute-default-initargs class)) (update-ctors 'finalize-inheritance :class class)) - (unless finalizep - (dolist (sub (class-direct-subclasses class)) - (update-class sub nil))))) + (dolist (sub (class-direct-subclasses class)) + (update-class sub nil)))) (define-condition cpl-protocol-violation (reference-condition error) ((class :initarg :class :reader cpl-protocol-violation-class)