From 66cd2fda549d7708acb8685933e619b0922885d5 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Fri, 18 Nov 2022 20:05:29 +0100
Subject: add generator-xfold

---
 mew.scm        | 12 ++++++++++--
 mew.svnwiki    |  6 ++++++
 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)))
-- 
cgit 1.4.1