diff options
author | Leah Neukirchen <leah@vuxu.org> | 2022-12-01 18:58:39 +0100 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2022-12-01 22:56:35 +0100 |
commit | 34b44c8c44ef78563a38ef931cc78f8934f7e291 (patch) | |
tree | abca15d71d08ea2c81fbc2f2d84cec64bd363fa5 | |
parent | 9816d6cea8603026458251f22b147df73b106bd8 (diff) | |
download | mew-34b44c8c44ef78563a38ef931cc78f8934f7e291.tar.gz mew-34b44c8c44ef78563a38ef931cc78f8934f7e291.tar.xz mew-34b44c8c44ef78563a38ef931cc78f8934f7e291.zip |
add gsplit-on
-rw-r--r-- | mew.scm | 51 | ||||
-rw-r--r-- | mew.svnwiki | 7 | ||||
-rw-r--r-- | tests/test.mew | 10 |
3 files changed, 51 insertions, 17 deletions
diff --git a/mew.scm b/mew.scm index 524c10c..5828f36 100644 --- a/mew.scm +++ b/mew.scm @@ -7,7 +7,8 @@ empty? eof esc fail fin final for fun* gconcatenate gen generator-xfold generic-for-each genumerate get - gfix giterate gmatch gpick group-by-accumulator gslice-when gsplit gwindow + gfix giterate gmatch gpick group-by-accumulator gslice-when + gsplit gsplit-on gwindow imp inc inject into juxt keys @@ -534,6 +535,26 @@ (set! window (append (cdr window) (list next))) window))))))) + (define (gsplit-on pred gen) + (let ((slice '()) + (this #f)) + (lambda () + (if (eof-object? this) + this + (let loop () + (set! this (gen)) + (if (eof-object? this) + (if (null? slice) + (eof) + (reverse slice)) + (if (pred this) + (let ((finished-slice (reverse slice))) + (set! slice '()) + finished-slice) + (begin + (set! slice (cons this slice)) + (loop))))))))) + (define (gslice-when pred gen) (let ((slice #f) (prev #f) @@ -545,20 +566,20 @@ (set! this (eof))) (set! slice (list prev))) (if (eof-object? this) - this - (let loop () - (set! this (gen)) - (if (eof-object? this) - (reverse slice) - (if (pred prev this) - (let ((finished-slice (reverse slice))) - (set! slice (list this)) - (set! prev this) - finished-slice) - (begin - (set! slice (cons this slice)) - (set! prev this) - (loop))))))))) + this + (let loop () + (set! this (gen)) + (if (eof-object? this) + (reverse slice) + (if (pred prev this) + (let ((finished-slice (reverse slice))) + (set! slice (list this)) + (set! prev this) + finished-slice) + (begin + (set! slice (cons this slice)) + (set! prev this) + (loop))))))))) (define (genumerate gen) (let ((n -1)) diff --git a/mew.svnwiki b/mew.svnwiki index e6b437c..c204dbb 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -428,6 +428,13 @@ Generator yielding a sliding window of length {{<len>}} (as a list) over the values yielded by the generator {{<gen>}}. Yields never if the generator yielded fewer than {{<len>}} elements. +<procedure>(gsplit-on <pred> <gen>)</procedure> + +Partition the elements yielded by the generator {{<gen>}} into lists: +starts a new empty list when the predicate {{<pred>}} called with the +current element of the generator returns true. +In this case, the element is discarded. + <procedure>(gslice-when <pred> <gen>)</procedure> Partition the elements yielded by the generator {{<gen>}} into lists: diff --git a/tests/test.mew b/tests/test.mew index e674481..ff9685e 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -372,7 +372,14 @@ ; gwindow -; gslice-when +(test-group "gsplit-on" + (test '((1) (1) (3 7)) (into '() (gsplit-on even? (generator 1 2 1 2 3 7 0))))) + +(test-group "gslice-when" + (test '((1 2) (1 2 3) (0 7)) (into '() (gslice-when > (generator 1 2 1 2 3 0 7)))) + (test '() (into '() (gslice-when (op #t) (generator)))) + (test '((0)) (into '() (gslice-when (op #t) (generator 0)))) + (test '((0) (1)) (into '() (gslice-when (op #t) (generator 0 1))))) ; genumerate @@ -380,7 +387,6 @@ ; gfix -; final (test-group "final" (test 3 (final (generator 1 2 3))) (test #t (void? (final (generator))))) |