Changeset 12762


Ignore:
Timestamp:
Sep 4, 2009, 10:57:51 PM (10 years ago)
Author:
gb
Message:

Replace the internal function EXTRACT-INSTANCE-AND-CLASS-SLOTDS with
EXTRACT-INSTANCE-CLASS-AND-OTHER-SLOTDS, which returns as a third
value those slot definitions whose allocation is something other than
:CLASS or :INSTANCE. Use this in the COMPUTE-SLOTS :AROUND method;
remove a couple of (unused) functions that called the old function.

Primary DIRECT-SLOT-DEFINITION-CLASS and
DIRECT-EFFECTIVE-SLOT-DEFINITION-CLASS methods don't err on non-standard
:ALLOCATION options.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos.lisp

    r12708 r12762  
    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))
     44            (shared-slots)
     45            (other-slots))
    4546    (dolist (s slotds (values (instance-slots) (shared-slots)))
    4647      (case (%slot-definition-allocation s)
    4748        (:instance (instance-slots s))
    48         (:class (shared-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)))
     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.