Changeset 12660
- Timestamp:
- 05/08/10 21:55:47 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/java.lisp
r12583 r12660 326 326 327 327 ;;; JAVA-CLASS support 328 (defconstant +java-lang-object+ (jclass "java.lang.Object")) 328 329 329 330 (defclass java-class (standard-class) … … 331 332 :initform (error "class is required") 332 333 :reader java-class-jclass))) 334 335 ;;init java.lang.Object class 336 (defconstant +java-lang-object-class+ 337 (%register-java-class +java-lang-object+ 338 (mop::ensure-class (make-symbol "java.lang.Object") 339 :metaclass (find-class 'java-class) 340 :direct-superclasses (list (find-class 'java-object)) 341 :java-class +java-lang-object+))) 333 342 334 343 (defun ensure-java-class (jclass) … … 337 346 class 338 347 (%register-java-class 339 jclass (mop::ensure-class (make-symbol (jclass-name jclass)) 340 :metaclass (find-class 'java-class) 341 :direct-superclasses (if (jclass-superclass-p jclass (jclass "java.lang.Object")) 342 (list (find-class 'java-object)) 343 (mapcar #'ensure-java-class 344 (delete nil 345 (concatenate 'list (list (jclass-superclass jclass)) 346 (jclass-interfaces jclass))))) 347 :java-class jclass))))) 348 jclass (mop::ensure-class 349 (make-symbol (jclass-name jclass)) 350 :metaclass (find-class 'java-class) 351 :direct-superclasses (mapcar #'ensure-java-class 352 (remove-duplicates 353 (delete nil 354 (concatenate 'list 355 (list (jclass-superclass jclass)) 356 (jclass-interfaces jclass))) 357 :key #'jclass-name :test #'string=)) 358 :java-class jclass))))) 359 360 (defmethod mop::compute-class-precedence-list ((class java-class)) 361 "Sort classes this way: 362 1. Java classes (but not java.lang.Object) 363 2. Java interfaces 364 3. java.lang.Object 365 4. other classes 366 Rationale: 367 1. Concrete classes are the most specific. 368 2. Then come interfaces. 369 So if a generic function is specialized both on an interface and a concrete class, 370 the concrete class comes first. 371 3. because everything is an Object. 372 4. to handle base CLOS classes. 373 Note: Java interfaces are not sorted among themselves in any way, so if a 374 gf is specialized on two different interfaces and you apply it to an object that 375 implements both, it is unspecified which method will be called." 376 (let ((cpl (call-next-method))) 377 (flet ((score (class) 378 (if (not (typep class 'java-class)) 379 4 380 (cond 381 ((jcall (jmethod "java.lang.Object" "equals" "java.lang.Object") 382 (java-class-jclass class) +java-lang-object+) 3) 383 ((jclass-interface-p (java-class-jclass class)) 2) 384 (t 1))))) 385 (stable-sort cpl #'(lambda (x y) 386 (< (score x) (score y))))))) 348 387 349 388 (defmethod make-instance ((class java-class) &rest initargs &key &allow-other-keys)
Note: See TracChangeset
for help on using the changeset viewer.