summary refs log tree commit diff
path: root/mew.scm
diff options
context:
space:
mode:
Diffstat (limited to 'mew.scm')
-rw-r--r--mew.scm20
1 files changed, 18 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 ...)