Changeset 13874
- Timestamp:
- 02/22/12 09:26:50 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13857 r13874 164 164 (define-class->%class-forwarder class-direct-default-initargs) 165 165 (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 166 204 167 205 (defun no-applicable-method (generic-function &rest args)
Note: See TracChangeset
for help on using the changeset viewer.