Ignore:
Timestamp:
Oct 9, 2009, 6:07:50 PM (10 years ago)
Author:
gz
Message:

fixes for slots with non-standard allocation (r12760,r12761,r12762,r12765, r12905)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r12202 r12950  
    4040  (extract-slotds-with-allocation :class (%class-slots class)))
    4141
    42 (defun extract-instance-and-class-slotds (slotds)
     42(defun extract-instance-class-and-other-slotds (slotds)
    4343  (collect ((instance-slots)
    44             (shared-slots))
    45     (dolist (s slotds (values (instance-slots) (shared-slots)))
    46       (if (eq (%slot-definition-allocation s) :class)
    47         (shared-slots s)
    48         (instance-slots s)))))
    49 
    50 
    51 
    52 (defun direct-instance-and-class-slotds (class)
    53   (extract-instance-and-class-slotds (%class-direct-slots class)))
    54 
    55 (defun effective-instance-and-class-slotds (class)
    56   (extract-instance-and-class-slotds (%class-slots class)))
     44            (shared-slots)
     45            (other-slots))
     46    (dolist (s slotds (values (instance-slots) (shared-slots) (other-slots)))
     47      (case (%slot-definition-allocation s)
     48        (:instance (instance-slots s))
     49        (:class (shared-slots s))
     50        (t (other-slots s))))))
     51
    5752
    5853(defun %early-shared-initialize (instance slot-names initargs)
     
    153148(defmethod compile-time-class-p ((class class)) nil)
    154149
    155 (defmethod direct-slot-definition-class ((class std-class) &key (allocation :instance) &allow-other-keys)
    156   (unless (member allocation '(:instance :class))
    157     (report-bad-arg allocation '(member (:instance :class))))
     150(defmethod direct-slot-definition-class ((class std-class) &key  &allow-other-keys)
    158151  *standard-direct-slot-definition-class*)
    159152
    160 (defmethod effective-slot-definition-class ((class std-class) &key (allocation :instance) &allow-other-keys)
    161   (unless (member allocation '(:instance :class))
    162     (report-bad-arg allocation '(member (:instance :class))))
     153(defmethod effective-slot-definition-class ((class std-class) &key  &allow-other-keys)
    163154  *standard-effective-slot-definition-class*)
    164155
     
    252243(defmethod compute-slots :around ((class std-class))
    253244  (let* ((cpl (%class.cpl class)))
    254     (multiple-value-bind (instance-slots class-slots)
    255         (extract-instance-and-class-slotds (call-next-method))
     245    (multiple-value-bind (instance-slots class-slots other-slots)
     246        (extract-instance-class-and-other-slotds (call-next-method))
    256247      (setq instance-slots (sort-effective-instance-slotds instance-slots class cpl))
    257248      (do* ((loc 1 (1+ loc))
     
    266257                                 :class-slots)
    267258                     :test #'eq)))
    268       (append instance-slots class-slots))))
     259      (append instance-slots class-slots other-slots))))
    269260
    270261(defmethod compute-slots :around ((class structure-class))
Note: See TracChangeset for help on using the changeset viewer.