Changeset 15001

Timestamp:

Sep 28, 2011, 3:02:58 AM (13 years ago)

Author:

Gary Byers

Message:

Move some of the class initialiation code for SLOTS-CLASS from an
:AFTER method on SHARED-INITIALIZE to a new internal method called
from new :AFTER-METHODS on INITIALIZE-INSTANCE and
REINITIALIZE-INSTANCE.

(The SHARED-INITIALIZE :AFTER method only exists to declare initargs
at this point.)

File:

• trunk/source/level-1/l1-clos.lisp (modified) (2 diffs)

trunk/source/level-1/l1-clos.lisp

@@ -711 +711 @@
   (remove-accessor-methods class (%class-direct-slots class))
   (remove-direct-subclasses class (%class-direct-superclasses class) direct-superclasses))
-   
-(defmethod shared-initialize :after
-  ((class slots-class)
-   slot-names &key
-   (direct-superclasses nil direct-superclasses-p)
-   (direct-slots nil direct-slots-p)
-   (direct-default-initargs nil direct-default-initargs-p)
-   (documentation nil doc-p)
-   (primary-p nil primary-p-p))
-  (if (or direct-superclasses-p (eq slot-names t))
+
+(defmethod ensure-class-initialized ((class slots-class) &key
+                                     (direct-superclasses nil direct-superclasses-p)
+                                     (direct-slots nil direct-slots-p)
+                                     (direct-default-initargs nil direct-default-initargs-p)
+                                     (documentation nil doc-p)
+                                     (primary-p nil primary-p-p)
+                                     &allow-other-keys)
+  (if direct-superclasses-p
     (progn
       (setq direct-superclasses
@@ -770 +769 @@
   (add-accessor-methods class direct-slots))
 
+(defmethod shared-initialize :after
+  ((class slots-class)
+   slot-names &key
+   direct-superclasses
+   direct-slots
+   direct-default-initargs
+   documentation
+   primary-p)
+  (declare (ignorable slot-names direct-superclasses 
+                      direct-slots 
+                      direct-default-initargs 
+                      documentation 
+                      primary-p))
+)
+
+
 (defmethod initialize-instance :before ((class class) &key &allow-other-keys)
   (setf (%class-ordinal class) (%next-class-ordinal))
   (setf (%class.ctype class) (make-class-ctype class)))
+
+(defmethod initialize-instance :after ((class slots-class) &rest keys &key)
+  (apply #'ensure-class-initialized class keys))
+
+(defmethod reinitialize-instance :after ((class slots-class) &rest keys &key )
+  (apply #'ensure-class-initialized class keys))
 
 (defun ensure-class-metaclass-and-initargs (class args)