diff options
| -rw-r--r-- | mew.scm | 12 | ||||
| -rw-r--r-- | mew.svnwiki | 6 | ||||
| -rw-r--r-- | tests/test.mew | 4 |
3 files changed, 20 insertions, 2 deletions
diff --git a/mew.scm b/mew.scm index aa438bd..e4a07c0 100644 --- a/mew.scm +++ b/mew.scm @@ -6,8 +6,8 @@ dec def del-at div empty? eof esc fail fin final for fun* - gconcatenate gen generic-for-each genumerate get gfix giterate gmatch - gpick group-by-accumulator gslice-when gsplit gwindow + gconcatenate gen generator-xfold generic-for-each genumerate get + gfix giterate gmatch gpick group-by-accumulator gslice-when gsplit gwindow imp inc inject into juxt keys @@ -750,6 +750,14 @@ (hash-table-values items) (hash-table-update!/default items (f x) identity x))))))) + (define (generator-xfold f seed . gs) + (define (inner-xfold seed) + (let ((vs (map (lambda (g) (g)) gs))) + (if (any eof-object? vs) + seed + (inner-xfold (apply f seed vs))))) + (inner-xfold seed)) + (define-syntax one-of (er-macro-transformer (lambda (expr rename compare) diff --git a/mew.svnwiki b/mew.svnwiki index c10a557..3b4fb3f 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -452,6 +452,12 @@ Returns an accumulator that returns a list of unique elements. Two elements are considered equal if their image under {{<f>}} is {{equal?}}. {{<f>}} defaults to the identity function. +<procedure>(generator-xfold <f> <seed> <generators>...)</procedure> + +Like {{generator-fold}}, but {{<f>}} always takes the accumulator as +first arguments, and the items after. This is more practical when +multiple {{<generators>}} are passed. + <procedure>(inject <f> <init>?)</procedure> Returns a procedure that takes an generator (or something convertible diff --git a/tests/test.mew b/tests/test.mew index e638377..ddf376c 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -435,6 +435,10 @@ (test 43 ((per * inc) 6 7)) (test 42 ((per) 42))) +(test-group "generator-xfold" + (test -10 (generator-xfold - 0 (generator 1 2 3 4))) + (test '((((() 1 5) 2 6) 3 7) 4 8) (generator-xfold list '() (generator 1 2 3 4) (generator 5 6 7 8)))) + (test-group "inject" (test 10 ((inject +) (generator 1 2 3 4))) (test 0 ((inject +) (generator))) |