Add split-by-one-of.

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

3 files changed, 65 insertions, 0 deletions

diff --git a/doc/ref/guile/util.texi b/doc/ref/guile/util.texi
index 32df5fce..222b59c5 100644
--- a/doc/ref/guile/util.texi
+++ b/doc/ref/guile/util.texi
@@ -198,6 +198,27 @@ Split a list into sub-lists on @var{element}
 @end lisp
 @end defun
 
+@defun split-by-one-of lst items
+Like split-by, but takes a list of delimiters.
+Returns a list where the first element is everything before the first
+delimiter, and the remaining elements is the splitting delimiter
+consed with everything until the next delimiter.
+
+@lisp
+(split-by-one-of '() '(+)))
+⇒ (())
+
+(split-by-one-of '(1 + 2) '(/))
+⇒ ((1 + 2))
+
+(split-by-one-of '(1 + 2 - 3) '(+ -))
+⇒ ((1) (+ 2) (- 3))
+
+(split-by-one-of '(1 + 2 * 3 + 4) '(*))
+⇒ ((1 + 2) (* 3 + 4))
+@end lisp
+@end defun
+
 
 @defun span-upto count predicate list
 Simar to span from srfi-1, but never takes more than
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.
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 1de96a37..aa37d20c 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -187,6 +187,25 @@
 
 (test-error 'wrong-type-arg (find-extreme '()))
 
+;; TODO group-by
+;; TODO split-by
+
+(test-group "Split-by-one-of"
+
+  (test-equal "Empty input"
+    '(()) (split-by-one-of '() '(+)))
+
+  (test-equal "No matching tokens"
+    '((1 + 2)) (split-by-one-of '(1 + 2) '(/)))
+
+  (test-equal "Matching tokens"
+    '((1) (+ 2) (- 3))
+    (split-by-one-of '(1 + 2 - 3) '(+ -)))
+
+  (test-equal "Maching tokens, multiple values in each group"
+    '((1 + 2) (* 3 + 4))
+    (split-by-one-of '(1 + 2 * 3 + 4) '(*))))
+
 (call-with-values
   (lambda ()
     (span-upto