0.pre8.115:
[sbcl.git] / src / pcl / std-class.lisp
index 76b3343..2f88079 100644 (file)
        (compute-slot-accessor-info slotd type gf)))
     (initialize-internal-slot-gfs name)))
 
+;;; CMUCL (Gerd PCL 2003-04-25) comment:
+;;;
+;;; Compute an effective method for SLOT-VALUE-USING-CLASS, (SETF
+;;; SLOT-VALUE-USING-CLASS) or SLOT-BOUNDP-USING-CLASS for reading/
+;;; writing/testing effective slot SLOTD.
+;;;
+;;; TYPE is one of the symbols READER, WRITER or BOUNDP, depending on
+;;; GF.  Store the effective method in the effective slot definition
+;;; object itself; these GFs have special dispatch functions calling
+;;; effective methods directly retrieved from effective slot
+;;; definition objects, as an optimization.
+;;;
+;;; FIXME: Change the function name to COMPUTE-SVUC-SLOTD-FUNCTION,
+;;; or some such.
 (defmethod compute-slot-accessor-info ((slotd effective-slot-definition)
                                       type gf)
   (let* ((name (slot-value slotd 'name))
   (setf (plist-value class 'default-initargs) inits))
 \f
 (defmethod compute-default-initargs ((class slot-class))
-  (let ((cpl (class-precedence-list class))
-       (direct (class-direct-default-initargs class)))
-    (labels ((walk (tail)
-              (if (null tail)
-                  nil
-                  (let ((c (pop tail)))
-                    (append (if (eq c class)
-                                direct
-                                (class-direct-default-initargs c))
-                            (walk tail))))))
-      (let ((initargs (walk cpl)))
-       (delete-duplicates initargs :test #'eq :key #'car :from-end t)))))
+  (let ((initargs (loop for c in (class-precedence-list class)
+                       append (class-direct-default-initargs c))))
+    (delete-duplicates initargs :test #'eq :key #'car :from-end t)))
 \f
 ;;;; protocols for constructing direct and effective slot definitions