diff options
| -rw-r--r-- | mew.scm | 22 | ||||
| -rw-r--r-- | mew.svnwiki | 6 | ||||
| -rw-r--r-- | tests/test.mew | 7 |
3 files changed, 34 insertions, 1 deletions
diff --git a/mew.scm b/mew.scm index 8635195..be9ae9b 100644 --- a/mew.scm +++ b/mew.scm @@ -9,7 +9,7 @@ gconcatenate gen generator-xfold generic-for-each genumerate get gfix giterate gmatch gpick group-by-accumulator gslice-when gsplit gsplit-on gwindow - imp inc inject into + imp inc inject inject-accumulator into juxt keys len lines loc @@ -962,6 +962,26 @@ (set! state x)) (set! n (dec n))))))) + (define inject-accumulator + (case-lambda + ((f) (let ((first #t) + (state (void))) + (lambda (x) + (if (eof-object? x) + (if first + (f) + state) + (if first + (begin + (set! state x) + (set! first #f)) + (set! state (f state x))))))) + ((f init) (let ((state init)) + (lambda (x) + (if (eof-object? x) + state + (set! state (f state x)))))))) + (define (generator-xfold f seed . gs) (define (inner-xfold seed) (let ((vs (map (lambda (g) (g)) gs))) diff --git a/mew.svnwiki b/mew.svnwiki index 1b8c0ae..3d30816 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -503,6 +503,12 @@ Two elements are considered equal if their image under {{<f>}} is {{equal?}}. Returns an accumulator that saves the {{<n>}}-th element, or an void value else. +<procedure>(inject-accumulator <f> [<init>])</procedure> + +Returns an accumulator that xfolds {{<f>}} over the elements. +If given, folding starts with {{<init>}}, else with the first element +received. + <procedure>(generator-xfold <f> <seed> <generators>...)</procedure> Like {{generator-fold}}, but {{<f>}} always takes the accumulator as diff --git a/tests/test.mew b/tests/test.mew index cbcf2ff..d72b881 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -501,6 +501,13 @@ (test #t (void? (into (nth-accumulator 8) '(4 5 6 7)))) (test #t (void? (into (nth-accumulator 8) '())))) +(test-group "inject-accumulator" + (test 10 (into (inject-accumulator +) (generator 1 2 3 4))) + (test 0 (into (inject-accumulator +) (generator))) + (test 20 (into (inject-accumulator + 10) (generator 1 2 3 4))) + (test 10 (into (inject-accumulator + 10) (generator))) + (test '((1 . 2) . 3) (into (inject-accumulator cons) (generator 1 2 3)))) + (test-group "one-of" (test #t ((one-of 1 2 3) 1)) (test #f ((one-of 1 2 3) 4)) |