From 3779df17f2726c2ad4c6904016f2b27c5049ed0d Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Fri, 18 Nov 2022 00:04:05 +0100
Subject: add odometer/cross-product

---
 mew.scm        | 20 ++++++++++++++++++--
 mew.svnwiki    | 11 +++++++++++
 tests/test.mew | 13 +++++++++++++
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/mew.scm b/mew.scm
index 7250d1e..520001f 100644
--- a/mew.scm
+++ b/mew.scm
@@ -2,7 +2,7 @@
   (export
      act accumulate andloc at
      boolean
-     comp
+     comp cross-product
      dec def del-at div
      empty? eof esc
      fail fin final for fun*
@@ -14,7 +14,7 @@
      len loc
      mod
      negate
-     one-of op op*
+     odometer one-of op op*
      per prn proj puts
      range rep
      scan scan-right sing? search seq set set-at str slurp
@@ -493,6 +493,22 @@
   (define (final g)
     (generator-fold (lambda (x a) x) (void) g))
 
+  (define (odometer . wheels)
+    (define (grepeat rep gen)
+      (gconcatenate (gmap (lambda (item)
+                            (gtake (cycle item) rep))
+                          gen)))
+    (if (null? wheels)
+      (generator)
+      (match-let (((total . parts) (scan-right * 1 wheels)))
+        (gtake (apply gmap list (map (lambda (r i)
+                                       (grepeat r (gmap (op mod _ i) (range 0))))
+                                     parts wheels))
+               total))))
+
+  (define (cross-product . xs)
+    (gmap (op map get xs _) (apply odometer (map len xs))))
+
   (define-syntax and-apply
     (syntax-rules ()
       ((_ x f args ...)
diff --git a/mew.svnwiki b/mew.svnwiki
index 3968b98..f11e5d6 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -446,6 +446,17 @@ by {{gen}}) and folds the function {{<f>}} over its values.  If given,
 folding starts with {{<init>}}, else with the first element yielded by
 the generator.  If the generator is empty, return {{(<f>)}}.
 
+<procedure>(odometer <wheels>...)</procedure>
+
+Returns a generator that takes a list of numbers and yields all
+combinations of numbers such that each is below it's wheel.  The
+rightmost number changes most quickly.
+
+<procedure>(cross-product <obj>...)</procedure>
+
+Returns a generator that takes multiple lists/vectors/strings and
+yields all elements of their cartesian product (as lists).
+
 
 == Regular expressions
 
diff --git a/tests/test.mew b/tests/test.mew
index b08bfd6..328e282 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -357,6 +357,19 @@
   (test 3 (final (generator 1 2 3)))
   (test #t (void? (final (generator)))))
 
+(test-group "odometer"
+  (test '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2)) (into '() (odometer 2 3)))
+  (test '((0) (1) (2)) (into '() (odometer 3)))
+  (test '() (into '() (odometer)))
+  (test 1365 (len (odometer 3 5 7 13))))
+
+(test-group "cross-product"
+  (test '((a X) (a Y) (b X) (b Y) (c X) (c Y))
+        (into '() (cross-product '(a b c) '(X Y))))
+  (test '((a) (b) (c))
+        (into '() (cross-product '(a b c))))
+  (test '() (into '() (cross-product))))
+
 ; ->
 
 ; fun->
-- 
cgit 1.4.1