diff options
Diffstat (limited to 'mew.scm')
-rw-r--r-- | mew.scm | 20 |
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 ...) |