From 78ebb6e306d843bb45c0baad563be37828d32fae Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Thu, 17 Nov 2022 23:32:15 +0100
Subject: add scan/scan-right

---
 mew.scm        | 15 ++++++++++++++-
 mew.svnwiki    |  5 +++++
 tests/test.mew |  8 ++++++++
 3 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/mew.scm b/mew.scm
index 51c3e47..261c389 100644
--- a/mew.scm
+++ b/mew.scm
@@ -17,7 +17,7 @@
      one-of op op*
      per prn proj puts
      range rep
-     sing? search seq set set-at str slurp
+     scan scan-right sing? search seq set set-at str slurp
      tally-accumulator tbl time
      while
      uniq-accumulator unlist until
@@ -828,6 +828,19 @@
                  (loop (+ i (get t (get haystack (+ i ln) #f) (inc ln)))))
                #f)))))))
 
+  (define (scan kons knil . lists)
+    (reverse (apply fold (lambda (elt acc)
+                           (cons (kons elt (car acc)) acc))
+                    (list knil)
+                    lists)))
+
+  (define (scan-right kons knil . lists)
+    (apply fold-right (lambda (elt acc)
+                        (cons (kons elt (car acc)) acc))
+           (list knil)
+           lists))
+
+
   (let ((old-repl-prompt (repl-prompt)))
     (repl-prompt (lambda ()
                    (let ((old-prompt (old-repl-prompt)))
diff --git a/mew.svnwiki b/mew.svnwiki
index c248917..aaebac3 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -249,6 +249,11 @@ Ignores all arguments and returns a value where {{void?}} is true.
 
 Returns true if {{<va>}} is an unspecified value, else false.
 
+<procedure>(scan <kons> <knil> <lists>...)</procedure>
+<procedure>(scan-right <kons> <knil> <lists>...)</procedure>
+
+Like {{fold}}/{{fold-right}}, but collects all accumulator values.
+
 
 == I/O helpers
 
diff --git a/tests/test.mew b/tests/test.mew
index daeffc1..295d293 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -517,4 +517,12 @@
   (test 1 (search #(1 2 3) #(0 1 2 3 4)))
   (test 1 (search '(1 2 3) '(0 1 2 3 4))))
 
+(test-group "scan"
+  (test '(0 -4 -9 -15) (scan (flip -) 0 '(4 5 6)))
+  (test '(42) (scan * 42 '())))
+
+(test-group "scan-right"
+  (test '(5 -1 6 0)    (scan-right - 0 '(4 5 6)))
+  (test '(42) (scan-right * 42 '())))
+
 (test-exit)
-- 
cgit 1.4.1