summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ccwl/ccwl.scm16
-rw-r--r--tests/ccwl.scm34
2 files changed, 50 insertions, 0 deletions
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")