Changeset 13791


Ignore:
Timestamp:
01/17/12 22:44:37 (9 years ago)
Author:
rschlatte
Message:

Merge branch 'mop-work'

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
1 deleted
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r13775 r13791  
    655655    FORWARD_REFERENCED_CLASS.setCPL(FORWARD_REFERENCED_CLASS, CLASS,
    656656                                    SPECIALIZER, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
    657     FUNCALLABLE_STANDARD_OBJECT.setCPL(FUNCALLABLE_STANDARD_OBJECT, STANDARD_OBJECT, BuiltInClass.FUNCTION, BuiltInClass.CLASS_T);
     657    // Not all of these slots are necessary, but for now we take the
     658    // standard layout.  Instances of this class will be redefined and
     659    // get a new layout in due course.
     660    FORWARD_REFERENCED_CLASS.setClassLayout(layoutStandardClass);
     661    FORWARD_REFERENCED_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
     662    FUNCALLABLE_STANDARD_OBJECT.setCPL(FUNCALLABLE_STANDARD_OBJECT,
     663                                       STANDARD_OBJECT, BuiltInClass.FUNCTION,
     664                                       BuiltInClass.CLASS_T);
    658665    GENERIC_FUNCTION.setCPL(GENERIC_FUNCTION, METAOBJECT,
    659666                            FUNCALLABLE_STANDARD_OBJECT, STANDARD_OBJECT,
     
    786793    CLASS.finalizeClass();
    787794    FUNCALLABLE_STANDARD_CLASS.finalizeClass();
     795    FORWARD_REFERENCED_CLASS.finalizeClass();
    788796    GENERIC_FUNCTION.finalizeClass();
    789797    ARITHMETIC_ERROR.finalizeClass();
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13789 r13791  
    103103(defconstant +the-standard-object-class+ (find-class 'standard-object))
    104104(defconstant +the-standard-method-class+ (find-class 'standard-method))
     105(defconstant +the-forward-referenced-class+
     106  (find-class 'forward-referenced-class))
    105107(defconstant +the-standard-reader-method-class+
    106108  (find-class 'standard-reader-method))
     
    286288  (when (fboundp 'note-name-defined)
    287289    (note-name-defined name)))
    288 
    289 (defun canonicalize-direct-superclasses (direct-superclasses)
    290   (let ((classes '()))
    291     (dolist (class-specifier direct-superclasses)
    292       (let ((class (if (classp class-specifier)
    293                        class-specifier
    294                        (find-class class-specifier nil))))
    295         (unless class
    296           (setf class (make-forward-referenced-class class-specifier)))
    297         (when (and (typep class 'built-in-class)
    298                    (not (member class *extensible-built-in-classes*)))
    299           (error "Attempt to define a subclass of built-in-class ~S."
    300                  class-specifier))
    301         (push class classes)))
    302     (nreverse classes)))
    303290
    304291(defun canonicalize-defclass-options (options)
     
    25482535               :format-arguments (list name))))))
    25492536
     2537(defun canonicalize-direct-superclasses (direct-superclasses)
     2538  (let ((classes '()))
     2539    (dolist (class-specifier direct-superclasses)
     2540      (let ((class (if (classp class-specifier)
     2541                       class-specifier
     2542                       (find-class class-specifier nil))))
     2543        (unless class
     2544          (setf class (make-instance +the-forward-referenced-class+
     2545                                     :name class-specifier))
     2546          (setf (find-class class-specifier) class))
     2547        (when (and (typep class 'built-in-class)
     2548                   (not (member class *extensible-built-in-classes*)))
     2549          (error "Attempt to define a subclass of built-in-class ~S."
     2550                 class-specifier))
     2551        (push class classes)))
     2552    (nreverse classes)))
     2553
    25502554 ;;; AMOP pg. 182
    25512555(defun ensure-class (name &rest all-keys &key &allow-other-keys)
     
    25542558;;; AMOP pg. 183ff.
    25552559(defgeneric ensure-class-using-class (class name &key direct-default-initargs
    2556                                       direct-slots direct-superclasses name
     2560                                      direct-slots direct-superclasses
    25572561                                      metaclass &allow-other-keys))
    25582562
     
    25842588  (error "The symbol ~S names a built-in class." name))
    25852589
    2586  (defmethod ensure-class-using-class ((class forward-referenced-class) name
    2587                                       &key (metaclass +the-standard-class+)
    2588                                       direct-superclasses
    2589                                       &rest all-keys &key &allow-other-keys)
    2590    (setf all-keys (copy-list all-keys))  ; since we modify it
    2591    (remf all-keys :metaclass)
    2592    (change-class class metaclass)
    2593    (apply #'reinitialize-instance class
    2594           :direct-superclasses (canonicalize-direct-superclasses
    2595                                 direct-superclasses)
    2596           all-keys)
    2597    class)
     2590(defmethod ensure-class-using-class ((class forward-referenced-class) name
     2591                                     &rest all-keys
     2592                                     &key (metaclass +the-standard-class+)
     2593                                     direct-superclasses &allow-other-keys)
     2594  (setf all-keys (copy-list all-keys))  ; since we modify it
     2595  (remf all-keys :metaclass)
     2596  (change-class class metaclass)
     2597  (apply #'reinitialize-instance class
     2598         :name name
     2599         :direct-superclasses (canonicalize-direct-superclasses
     2600                               direct-superclasses)
     2601         all-keys)
     2602  class)
    25982603
    25992604(defmethod ensure-class-using-class ((class class) name
     
    26012606                                     direct-superclasses &rest all-keys
    26022607                                     &allow-other-keys)
     2608  (declare (ignore name))
    26032609  (setf all-keys (copy-list all-keys))  ; since we modify it
    26042610  (remf all-keys :metaclass)
     
    30473053  (std-shared-initialize instance slot-names initargs))
    30483054
     3055(defmethod shared-initialize :after ((instance standard-class) slot-names
     3056                                     &key direct-superclasses
     3057                                     direct-slots direct-default-initargs
     3058                                     &allow-other-keys)
     3059  (std-after-initialization-for-classes
     3060   instance :direct-superclasses direct-superclasses
     3061   :direct-slots direct-slots
     3062   :direct-default-initargs direct-default-initargs))
     3063
     3064(defmethod shared-initialize :after ((instance funcallable-standard-class)
     3065                                     slot-names &key direct-superclasses
     3066                                     direct-slots direct-default-initargs
     3067                                     &allow-other-keys)
     3068  (std-after-initialization-for-classes
     3069   instance :direct-superclasses direct-superclasses
     3070   :direct-slots direct-slots
     3071   :direct-default-initargs direct-default-initargs))
     3072
    30493073(defmethod shared-initialize ((slot slot-definition) slot-names
    30503074                              &rest args
Note: See TracChangeset for help on using the changeset viewer.