From c37a8e33f790b385ec1f913b062ad5b5f4bbe96e Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 27 Feb 2021 23:50:48 +0530
Subject: Add break-pair utility.

* ccwl/ccwl.scm (break-pair): New function.
* tests/ccwl.scm: New file.
* tests/ccwl.scm ("break-pair", "break-pair: check last elemet
handling"): New test cases.
---
 ccwl/ccwl.scm  | 16 ++++++++++++++++
 tests/ccwl.scm | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100644 tests/ccwl.scm

diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm
index 1f69d41..0d261d6 100644
--- a/ccwl/ccwl.scm
+++ b/ccwl/ccwl.scm
@@ -80,6 +80,22 @@ variable."
            (parse-arguments tail (1+ position))))
     (() '())))
 
+(define (break-pair pred lst)
+  "Return the longest initial prefix of LST that does not satisfy PRED,
+and the remaining tail. PRED is a 2-arity predicate. For each element
+under consideration, PRED is passed that element and the next. For the
+last element of LST, PRED is passed that element alone."
+  (match lst
+    ((head next tail ...)
+     (if (not (pred head next))
+         (let ((prefix tail (break-pair pred (cons next tail))))
+           (values (cons head prefix) tail))
+         (values (list) lst)))
+    ((last)
+     (if (not (pred last))
+         (values lst (list))
+         (values (list) lst)))))
+
 (define (parse-command args)
   "Parse ARGS, a list of command line arguments and return two
 lists---the base command and the actual arguments."
diff --git a/tests/ccwl.scm b/tests/ccwl.scm
new file mode 100644
index 0000000..3d4799c
--- /dev/null
+++ b/tests/ccwl.scm
@@ -0,0 +1,34 @@
+(use-modules (srfi srfi-71)
+             (srfi srfi-64))
+
+(define break-pair
+  (module-ref (resolve-module '(ccwl ccwl))
+              'break-pair))
+
+(test-begin "ccwl")
+
+(test-assert "break-pair"
+  (let ((prefix tail
+                (break-pair (case-lambda
+                              ((element next)
+                               (or (odd? element)
+                                   (odd? next)))
+                              ((last)
+                               (odd? last)))
+                            (list 12 66 74 95 7 74 96 46 99 76 37))))
+    (equal? prefix (list 12 66))
+    (equal? tail (list 74 95 7 74 96 46 99 76 37))))
+
+(test-assert "break-pair: check last elemet handling"
+  (let ((prefix tail
+                (break-pair (case-lambda
+                              ((element next)
+                               (or (odd? element)
+                                   (odd? next)))
+                              ((last)
+                               (odd? last)))
+                            (list 12 66 74))))
+    (equal? prefix (list 12 66 74))
+    (equal? tail (list))))
+
+(test-end "ccwl")
-- 
cgit v1.2.3