Changeset 13874


Ignore:
Timestamp:
02/22/12 09:26:50 (9 years ago)
Author:
rschlatte
Message:

Fix class hierarchy of standard classes

... (class-direct-subclasses (car (class-direct-superclasses ...)))

returned NIL for our MOP classes.

File:
1 edited

Legend:

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

    r13857 r13874  
    164164(define-class->%class-forwarder class-direct-default-initargs)
    165165(define-class->%class-forwarder (setf class-direct-default-initargs))
     166
     167(defun fixup-standard-class-hierarchy ()
     168  ;; Make the result of class-direct-subclasses for the pre-built
     169  ;; classes agree with AMOP Table 5.1 (pg. 141).  This could be done in
     170  ;; StandardClass.java where these classes are defined, but here it's
     171  ;; less painful
     172  (flet ((add-subclasses (class subclasses)
     173           (when (atom subclasses) (setf subclasses (list subclasses)))
     174           (setf (class-direct-subclasses (find-class class))
     175                 (union (class-direct-subclasses (find-class class))
     176                        (mapcar #'find-class subclasses)))))
     177    (add-subclasses t 'standard-object)
     178    (add-subclasses 'function 'funcallable-standard-object)
     179    (add-subclasses 'standard-object '(funcallable-standard-object metaobject))
     180    (add-subclasses 'metaobject
     181                    '(generic-function method method-combination
     182                      slot-definition specializer))
     183    (add-subclasses 'funcallable-standard-object 'generic-function)
     184    (add-subclasses 'generic-function 'standard-generic-function)
     185    (add-subclasses 'method 'standard-method)
     186    (add-subclasses 'standard-method 'standard-accessor-method)
     187    (add-subclasses 'standard-accessor-method
     188                    '(standard-reader-method standard-writer-method))
     189    (add-subclasses 'slot-definition
     190                    '(direct-slot-definition effective-slot-definition
     191                      standard-slot-definition))
     192    (add-subclasses 'standard-slot-definition
     193                    '(standard-direct-slot-definition
     194                      standard-effective-slot-definition))
     195    (add-subclasses 'direct-slot-definition 'standard-direct-slot-definition)
     196    (add-subclasses 'effective-slot-definition
     197                    'standard-effective-slot-definition)
     198    (add-subclasses 'specializer '(eql-specializer class))
     199    (add-subclasses 'class
     200                    '(built-in-class forward-referenced-class standard-class
     201                      funcallable-standard-class))))
     202(fixup-standard-class-hierarchy)
     203
    166204
    167205(defun no-applicable-method (generic-function &rest args)
Note: See TracChangeset for help on using the changeset viewer.