From 8be1e42cfbf9e3bc9d64dc839969d4b4293afb53 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Mon, 12 Dec 2022 23:02:11 +0100
Subject: add nth-accumulator

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

diff --git a/mew.scm b/mew.scm
index f95c0b1..259f51c 100644
--- a/mew.scm
+++ b/mew.scm
@@ -14,7 +14,7 @@
      keys
      len lines loc
      mod
-     negate
+     negate nth-accumulator
      odometer one-of op op*
      per prn proj puts
      rand range rep
@@ -936,6 +936,16 @@
                  (hash-table-values items)
                  (hash-table-update!/default items (f x) identity x)))))))
 
+  (define (nth-accumulator n)
+    (let ((n n) (state (void)))
+      (lambda (x)
+        (if (eof-object? x) 
+           state
+           (begin
+             (when (zero? n)
+               (set! state x))
+             (set! n (dec n)))))))
+
   (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 11a2669..db141f4 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -492,6 +492,11 @@ 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>(nth-accumulator <n>)</procedure>
+
+Returns an accumulator that saves the {{<n>}}-th element, or
+an void value else.
+
 <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 72d1e27..a775928 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -486,6 +486,11 @@
 
 ; uniq-accumulator
 
+(test-group "nth-accumulator"
+  (test 6 (into (nth-accumulator 2) '(4 5 6 7)))
+  (test #t (void? (into (nth-accumulator 8) '(4 5 6 7))))
+  (test #t (void? (into (nth-accumulator 8) '()))))
+
 (test-group "one-of"
   (test #t ((one-of 1 2 3) 1))
   (test #f ((one-of 1 2 3) 4))
-- 
cgit 1.4.1