Changeset 13956
- Timestamp:
- 06/10/12 21:34:15 (9 years ago)
- Location:
- trunk/abcl/src/org/armedbear/lisp
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/SlotClass.java
r13541 r13956 123 123 LispObject computeDefaultInitargs() 124 124 { 125 // KLUDGE (rudi 2012-06-02): duplicate initargs are not removed 126 // here, but this does not hurt us since no Lisp class we define 127 // Java-side has non-nil direct default initargs. 125 128 LispObject result = NIL; 126 129 LispObject cpl = getCPL(); -
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
r13947 r13956 682 682 list(Symbol.SIMPLE_CONDITION_FORMAT_ARGUMENTS), 683 683 NIL))); 684 CONDITION.setDirectDefaultInitargs(list(Keyword.FORMAT_ARGUMENTS, 685 // FIXME 686 new Closure(list(Symbol.LAMBDA, NIL, NIL), 687 new Environment()))); 684 CONDITION.setDirectDefaultInitargs(list(list(Keyword.FORMAT_ARGUMENTS, 685 NIL, 686 constantlyNil))); 688 687 CONTROL_ERROR.setCPL(CONTROL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION, 689 688 STANDARD_OBJECT, BuiltInClass.CLASS_T); -
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13955 r13956 370 370 (list 371 371 ':direct-default-initargs 372 `(list ,@(mapappend 373 #'(lambda (x) x) 374 (mapplist 375 #'(lambda (key value) 376 `(',key ,(make-initfunction value))) 377 (cdr option)))))) 372 `(list ,@(mapplist 373 #'(lambda (key value) 374 `(list ',key ',value ,(make-initfunction value))) 375 (cdr option))))) 378 376 ((:documentation :report) 379 377 (list (car option) `',(cadr option))) … … 506 504 507 505 (defun std-compute-class-default-initargs (class) 508 (mapcan #'(lambda (c) 509 (copy-list 510 (class-direct-default-initargs c))) 511 (class-precedence-list class))) 506 (delete-duplicates 507 (mapcan #'(lambda (c) 508 (copy-list 509 (class-direct-default-initargs c))) 510 (class-precedence-list class)) 511 :key #'car :from-end t)) 512 512 513 513 (defun std-finalize-inheritance (class) … … 3381 3381 (defun augment-initargs-with-defaults (class initargs) 3382 3382 (let ((default-initargs '())) 3383 (do * ((list (class-default-initargs class) (cddr list))3384 (key (car list) (car list))3385 (fn (cadr list) (cadr list)))3386 ((null list))3387 (when (eq (getf initargs key 'not-found) 'not-found)3388 (setf default-initargs (append default-initargs (list key (funcall fn))))))3389 (append initargs default-initargs)))3383 (dolist (initarg (class-default-initargs class)) 3384 (let ((key (first initarg)) 3385 (fn (third initarg))) 3386 (when (eq (getf initargs key +slot-unbound+) +slot-unbound+) 3387 (push key default-initargs) 3388 (push (funcall fn) default-initargs)))) 3389 (append initargs (nreverse default-initargs)))) 3390 3390 3391 3391 (defmethod make-instance ((class standard-class) &rest initargs)
Note: See TracChangeset
for help on using the changeset viewer.