diff options
| author | Leah Neukirchen <leah@vuxu.org> | 2022-12-12 23:02:11 +0100 |
|---|---|---|
| committer | Leah Neukirchen <leah@vuxu.org> | 2022-12-16 00:12:57 +0100 |
| commit | 8be1e42cfbf9e3bc9d64dc839969d4b4293afb53 (patch) | |
| tree | 9c4d49279f83565999a712582514a9d3489932e7 | |
| parent | 0c5dec75a7c68ca69384bbc27f8a273976de92d1 (diff) | |
| download | mew-8be1e42cfbf9e3bc9d64dc839969d4b4293afb53.tar.gz mew-8be1e42cfbf9e3bc9d64dc839969d4b4293afb53.tar.xz mew-8be1e42cfbf9e3bc9d64dc839969d4b4293afb53.zip | |
add nth-accumulator
| -rw-r--r-- | mew.scm | 12 | ||||
| -rw-r--r-- | mew.svnwiki | 5 | ||||
| -rw-r--r-- | tests/test.mew | 5 |
3 files changed, 21 insertions, 1 deletions
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)) |