diff options
| -rw-r--r-- | ccwl/ccwl.scm | 16 | ||||
| -rw-r--r-- | tests/ccwl.scm | 34 |
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") |