add inject-accumulator

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))