Add split-by-one-of.

A rather peculiar procedure, but "needed" to implement order of
operations on a flat list.

1 files changed, 25 insertions, 0 deletions

diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index d2c0dd5f..9a45704b 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -34,6 +34,8 @@
 
            group-by
            split-by
+           split-by-one-of
+
 
            span-upto
            cross-product
@@ -341,6 +343,29 @@
                  (cdr rem))])))
 
 
+(define (split-by-one-of lst items)
+  (cond ((null? items)
+         (scm-error 'wrong-type-arg "split-by-one-of"
+                    "Must have at least one item to split by, when splitting ~s"
+                    (cons items '()) #f))
+        ((not (list? items))
+         (scm-error 'wrong-type-arg "split-by-one-of"
+                    "Items must be list of list of symbols, got ~s"
+                    (list items) #f))
+        (else
+         (call-with-values
+             (lambda ()
+               (car+cdr
+                (let loop ((token 'sentinel-token) (lst lst))
+                  (let ((head tail (break (lambda (item) (memv item items))
+                                          lst)))
+                    (let ((group (cons token head)))
+                      (if (null? tail)
+                          (list group)
+                          (cons group (loop (car tail) (cdr tail)))))))))
+           ;; Remove the sentinel token
+           (lambda (first rest) (cons (cdr first) rest))))))
+
 
 ;; Simar to span from srfi-1, but never takes more than
 ;; @var{count} items. Can however still take less.