Changeset 15001


Ignore:
Timestamp:
Sep 28, 2011, 10:02:58 AM (8 years ago)
Author:
gb
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos.lisp

    r14862 r15001  
    711711  (remove-accessor-methods class (%class-direct-slots class))
    712712  (remove-direct-subclasses class (%class-direct-superclasses class) direct-superclasses))
    713    
    714 (defmethod shared-initialize :after
    715   ((class slots-class)
    716    slot-names &key
    717    (direct-superclasses nil direct-superclasses-p)
    718    (direct-slots nil direct-slots-p)
    719    (direct-default-initargs nil direct-default-initargs-p)
    720    (documentation nil doc-p)
    721    (primary-p nil primary-p-p))
    722   (if (or direct-superclasses-p (eq slot-names t))
     713
     714(defmethod ensure-class-initialized ((class slots-class) &key
     715                                     (direct-superclasses nil direct-superclasses-p)
     716                                     (direct-slots nil direct-slots-p)
     717                                     (direct-default-initargs nil direct-default-initargs-p)
     718                                     (documentation nil doc-p)
     719                                     (primary-p nil primary-p-p)
     720                                     &allow-other-keys)
     721  (if direct-superclasses-p
    723722    (progn
    724723      (setq direct-superclasses
     
    770769  (add-accessor-methods class direct-slots))
    771770
     771(defmethod shared-initialize :after
     772  ((class slots-class)
     773   slot-names &key
     774   direct-superclasses
     775   direct-slots
     776   direct-default-initargs
     777   documentation
     778   primary-p)
     779  (declare (ignorable slot-names direct-superclasses
     780                      direct-slots
     781                      direct-default-initargs
     782                      documentation
     783                      primary-p))
     784)
     785
     786
    772787(defmethod initialize-instance :before ((class class) &key &allow-other-keys)
    773788  (setf (%class-ordinal class) (%next-class-ordinal))
    774789  (setf (%class.ctype class) (make-class-ctype class)))
     790
     791(defmethod initialize-instance :after ((class slots-class) &rest keys &key)
     792  (apply #'ensure-class-initialized class keys))
     793
     794(defmethod reinitialize-instance :after ((class slots-class) &rest keys &key )
     795  (apply #'ensure-class-initialized class keys))
    775796
    776797(defun ensure-class-metaclass-and-initargs (class args)
Note: See TracChangeset for help on using the changeset viewer.