src/method-{proto,impl}.lisp: Abstract out the receiver type.

[sod] / src / utilities.lisp

diff --git a/src/utilities.lisp b/src/utilities.lisp
index a496283..25733e8 100644 (file)
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -451,6 +451,25 @@
    and return the result of appending all of the resulting lists."
   (reduce #'append (apply #'mapcar function list more-lists) :from-end t))
 
+(export 'cross-product)
+(defun cross-product (&rest pieces)
+  "Return the cross product of the PIECES.
+
+   Each arguments may be a list, or a (non-nil) atom, which is equivalent to
+   a singleton list containing just that atom.  Return a list of all possible
+   lists which can be constructed by taking one item from each argument list
+   in turn, in an arbitrary order."
+  (reduce (lambda (piece tails)
+           (mapcan (lambda (tail)
+                     (mapcar (lambda (head)
+                               (cons head tail))
+                             (if (listp piece) piece
+                                 (list piece))))
+                   tails))
+         pieces
+         :from-end t
+         :initial-value '(nil)))
+
 (export 'distinguished-point-shortest-paths)
 (defun distinguished-point-shortest-paths (root neighbours-func)
   "Moderately efficient shortest-paths-from-root computation.
@@ -717,18 +736,18 @@
                              (setf (gethash k seen) item)))))
                sequence)))
        ((listp sequence)
-        (mapl (lambda (tail)
-                (let* ((item (car tail))
-                       (rest (cdr tail))
-                       (match (member (funcall key item) rest
-                                      :test test :key key)))
-                  (when match (funcall report item (car match)))))
-              sequence))
+        (do ((tail sequence (cdr tail))
+             (i 0 (1+ i)))
+            ((endp tail))
+            (let* ((item (car tail))
+                   (match (find (funcall key item) sequence
+                                :test test :key key :end i)))
+              (when match (funcall report item match)))))
        ((vectorp sequence)
         (dotimes (i (length sequence))
           (let* ((item (aref sequence i))
                  (pos (position (funcall key item) sequence
-                                :key key :test test :start (1+ i))))
+                                :key key :test test :end i)))
             (when pos (funcall report item (aref sequence pos))))))
        (t
         (error 'type-error :datum sequence :expected-type 'sequence))))