From 34b44c8c44ef78563a38ef931cc78f8934f7e291 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Thu, 1 Dec 2022 18:58:39 +0100
Subject: add gsplit-on

---
 mew.scm        | 51 ++++++++++++++++++++++++++++++++++++---------------
 mew.svnwiki    |  7 +++++++
 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)))))
-- 
cgit 1.4.1