Changeset 13898


Ignore:
Timestamp:
03/28/12 21:36:39 (10 years ago)
Author:
rschlatte
Message:

Set type, documentation for effective slot definition objects.

File:
1 edited

Legend:

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

    r13897 r13898  
    665665(defun std-compute-effective-slot-definition (class name direct-slots)
    666666  (let ((initer (find-if-not #'null direct-slots
    667                              :key 'slot-definition-initfunction)))
     667                             :key 'slot-definition-initfunction))
     668        (documentation (find-if-not #'null direct-slots
     669                                    :key 'slot-definition-documentation))
     670        (types (delete-duplicates
     671                (delete t (mapcar #'slot-definition-type direct-slots))
     672                :test #'equal))
     673        )
    668674    (make-effective-slot-definition
    669675     class
     
    680686     :allocation (slot-definition-allocation (car direct-slots))
    681687     :allocation-class (when (slot-boundp (car direct-slots)
    682             'sys::allocation-class)
    683        ;;for some classes created in Java
    684        ;;(e.g. SimpleCondition) this slot is unbound
    685        (slot-definition-allocation-class (car direct-slots))))))
     688                                          'sys::allocation-class)
     689                         ;;for some classes created in Java
     690                         ;;(e.g. SimpleCondition) this slot is unbound
     691                         (slot-definition-allocation-class (car direct-slots)))
     692     :type (cond ((null types) t)
     693                 ((= 1 (length types)) types)
     694                 (t (list* 'and types)))
     695     :documentation documentation)))
    686696
    687697;;; Standard instance slot access
Note: See TracChangeset for help on using the changeset viewer.