0.pre7.95:
[sbcl.git] / src / pcl / vector.lisp
index 37226a7..c4555b4 100644 (file)
   (unless (listp wrappers) (setq wrappers (list wrappers)))
   (let* ((not-simple-p-cell (list nil))
         (elements
-         (gathering1 (collecting)
-           (iterate ((slot-names (list-elements slot-name-lists)))
+          (let ((elements nil))
+            (dolist (slot-names slot-name-lists)
              (when slot-names
                (let* ((wrapper     (pop wrappers))
                       (std-p (typep wrapper 'wrapper))
                       (class       (wrapper-class* wrapper))
                       (class-slots (and std-p (wrapper-class-slots wrapper))))
                  (dolist (slot-name (cdr slot-names))
-                   (gather1
-                    (when std-p
-                      (compute-pv-slot slot-name wrapper class
-                                       class-slots not-simple-p-cell))))))))))
+                    ;; Original PCL code had this idiom.  why not:
+                    ;;
+                    ;; (WHEN STD-P
+                    ;;   (PUSH ...)) ?
+                    (push (when std-p
+                            (compute-pv-slot slot-name wrapper class
+                                             class-slots not-simple-p-cell))
+                          elements)))))
+            (nreverse elements))))
     (if (car not-simple-p-cell)
        (make-permutation-vector (cons t elements))
        (or (gethash elements *pvs*)
 
 (defmacro pv-binding ((required-parameters slot-name-lists pv-table-symbol)
                      &body body)
-  (with-gathering ((slot-vars (collecting))
-                  (pv-parameters (collecting)))
-    (iterate ((slots (list-elements slot-name-lists))
-             (required-parameter (list-elements required-parameters))
-             (i (interval :from 0)))
-      (when slots
-       (gather required-parameter pv-parameters)
-       (gather (slot-vector-symbol i) slot-vars)))
-    `(pv-binding1 (.pv. .calls. ,pv-table-symbol ,pv-parameters ,slot-vars)
+  (let (slot-vars pv-parameters)
+    (loop for slots in slot-name-lists
+          for required-parameter in required-parameters
+          for i from 0
+          do (when slots
+               (push required-parameter pv-parameters)
+               (push (slot-vector-symbol i) slot-vars)))
+    `(pv-binding1 (.pv. .calls. ,pv-table-symbol
+                   ,(nreverse pv-parameters) ,(nreverse slot-vars))
        ,@body)))
 
 (defmacro pv-binding1 ((pv calls pv-table-symbol pv-parameters slot-vars)