diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-01-29 18:44:07 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-01-29 18:49:05 +0100 |
commit | 385ebecece12ad556683f8c98b8f9d612795737a (patch) | |
tree | a58818c4cbd79b917ac217e60f25a3abbd05580b | |
parent | Add ~b and ~p flags to datetime parser. (diff) | |
download | calp-385ebecece12ad556683f8c98b8f9d612795737a.tar.gz calp-385ebecece12ad556683f8c98b8f9d612795737a.tar.xz |
Add span-upto.
-rw-r--r-- | module/calp/util.scm | 25 | ||||
-rw-r--r-- | module/datetime.scm | 4 | ||||
-rw-r--r-- | tests/util.scm | 12 |
3 files changed, 38 insertions, 3 deletions
diff --git a/module/calp/util.scm b/module/calp/util.scm index 93e9fd0c..e1e2131a 100644 --- a/module/calp/util.scm +++ b/module/calp/util.scm @@ -388,6 +388,31 @@ (cdr rem))]))) + +;; Simar to span from srfi-1, but never takes more than +;; @var{count} items. Can however still take less. +;; @example +;; (span-upto 2 char-numeric? (string->list "123456")) +;; ⇒ (#\1 #\2) +;; ⇒ (#\3 #\4 #\5 #\6) +;; (span-upto 2 char-numeric? (string->list "H123456")) +;; ⇒ () +;; ⇒ (#\H #\1 #\2 #\3 #\4 #\5 #\6) +;; @end example +(define-public (span-upto count predicate list) + (let loop ((remaining count) + (taken '()) + (list list)) + (if (or (zero? remaining) (null? list)) + (values (reverse! taken) list) + (if (predicate (car list)) + (loop (1- remaining) + (cons (car list) taken) + (cdr list)) + (loop (1- remaining) + taken list))))) + + ;; Returns the cross product between l1 and l2. ;; each element is a cons cell. (define (cross-product% l1 l2) diff --git a/module/datetime.scm b/module/datetime.scm index 66eab8ca..e4a17779 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -712,7 +712,7 @@ Returns -1 on failure" ;; other than the top level, to allow better error ;; messages. (scm-error 'misc-error "string->datetime" - "Mismatched symbol, expected ~a got ~a" + "Mismatched symbol, expected ~s got ~s" (list #\~ (car str)) #f))] ;; TODO is this lost if not at the end? @@ -801,7 +801,7 @@ Returns -1 on failure" (cdr fmt) dt) (scm-error 'misc-error "string->datetime" - "Mismatched symbol, expected ~a got ~a" + "Mismatched symbol, expected ~s got ~s" (list (car fmt) (car str)) #f))]))) diff --git a/tests/util.scm b/tests/util.scm index de8d4b2a..6d4ca262 100644 --- a/tests/util.scm +++ b/tests/util.scm @@ -3,7 +3,7 @@ ;;; Code: (((calp util) filter-sorted set/r! - find-min find-max)) + find-min find-max span-upto)) (test-equal "Filter sorted" '(3 4 5) @@ -36,3 +36,13 @@ (test-error 'misc-error (find-extreme '())) + +(call-with-values (lambda () (span-upto 2 char-numeric? (string->list "123456"))) + (lambda (head tail) + (test-equal '(#\1 #\2) head) + (test-equal '(#\3 #\4 #\5 #\6) tail))) + +(call-with-values (lambda () (span-upto 2 char-numeric? (string->list "H123456"))) + (lambda (head tail) + (test-equal '() head) + (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))) |