diff options
| -rw-r--r-- | mew.scm | 15 | ||||
| -rw-r--r-- | mew.svnwiki | 5 | ||||
| -rw-r--r-- | tests/test.mew | 8 |
3 files changed, 27 insertions, 1 deletions
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) |