Browse code
Add partition to string-utils
Ed Langley authored on 06/07/2019 04:12:36Showing 2 changed files
| ... | ... |
@@ -10,3 +10,40 @@ |
| 10 | 10 |
(insert-at (position-if predicate string) |
| 11 | 11 |
item |
| 12 | 12 |
string)) |
| 13 |
+ |
|
| 14 |
+(defmacro expand-branch (condition form) |
|
| 15 |
+ ;;; intentionally expands form twice: this should be ok, because |
|
| 16 |
+ ;;; only one side of the if will execute |
|
| 17 |
+ `(if ,condition |
|
| 18 |
+ ,form |
|
| 19 |
+ ,form)) |
|
| 20 |
+ |
|
| 21 |
+(defun partition (at string &key from-end) |
|
| 22 |
+ (let ((from-end (not (not from-end)))) |
|
| 23 |
+ (flet ((partition-char (char string from-end) |
|
| 24 |
+ (declare (type character char) |
|
| 25 |
+ (type string string) |
|
| 26 |
+ (type boolean from-end) |
|
| 27 |
+ (optimize (speed 3))) |
|
| 28 |
+ (let ((pos (expand-branch from-end (position char string :from-end from-end)))) |
|
| 29 |
+ (if pos |
|
| 30 |
+ (list (subseq string 0 pos) |
|
| 31 |
+ (subseq string (1+ pos))) |
|
| 32 |
+ (list string |
|
| 33 |
+ nil)))) |
|
| 34 |
+ (partition-subseq (subseq string from-end) |
|
| 35 |
+ (declare (type sequence subseq) |
|
| 36 |
+ (type string string) |
|
| 37 |
+ (type boolean from-end) |
|
| 38 |
+ (optimize (speed 3))) |
|
| 39 |
+ (let ((pos (expand-branch from-end (search subseq string :from-end from-end)))) |
|
| 40 |
+ (if pos |
|
| 41 |
+ (list (subseq string 0 pos) |
|
| 42 |
+ (subseq string (+ (length subseq) pos))) |
|
| 43 |
+ (list string |
|
| 44 |
+ nil))))) |
|
| 45 |
+ (declare (inline partition-char partition-subseq) |
|
| 46 |
+ (optimize (speed 3))) |
|
| 47 |
+ (typecase at |
|
| 48 |
+ (character (partition-char at string from-end)) |
|
| 49 |
+ (sequence (partition-subseq at string from-end)))))) |
| ... | ... |
@@ -5,6 +5,48 @@ |
| 5 | 5 |
(length b)) |
| 6 | 6 |
(every 'equal a b))) |
| 7 | 7 |
|
| 8 |
+(progn |
|
| 9 |
+ (st:deftest string-partition-as-expected-1 () |
|
| 10 |
+ (st:should be vos-equal |
|
| 11 |
+ '("b" "d")
|
|
| 12 |
+ (partition "aa" "baad"))) |
|
| 13 |
+ |
|
| 14 |
+ (st:deftest string-partition-as-expected-1-end () |
|
| 15 |
+ (st:should be vos-equal |
|
| 16 |
+ '("ba" "")
|
|
| 17 |
+ (partition "ad" "baad"))) |
|
| 18 |
+ (st:deftest string-partition-as-expected-1-begin () |
|
| 19 |
+ (st:should be vos-equal |
|
| 20 |
+ '("" "ad")
|
|
| 21 |
+ (partition "ba" "baad"))) |
|
| 22 |
+ |
|
| 23 |
+ (st:deftest string-partition-as-expected-2 () |
|
| 24 |
+ (st:should be vos-equal |
|
| 25 |
+ '("b" "ad")
|
|
| 26 |
+ (partition #(#\a) "baad"))) |
|
| 27 |
+ (st:deftest string-partition-as-expected-2-end () |
|
| 28 |
+ (st:should be vos-equal |
|
| 29 |
+ '("ba" "")
|
|
| 30 |
+ (partition #(#\a #\d) "baad"))) |
|
| 31 |
+ (st:deftest string-partition-as-expected-2-begin () |
|
| 32 |
+ (st:should be vos-equal |
|
| 33 |
+ '("" "ad")
|
|
| 34 |
+ (partition #(#\b #\a) "baad"))) |
|
| 35 |
+ |
|
| 36 |
+ |
|
| 37 |
+ (st:deftest string-partition-as-expected-3 () |
|
| 38 |
+ (st:should be vos-equal |
|
| 39 |
+ '("b" "ad")
|
|
| 40 |
+ (partition #\a "baad"))) |
|
| 41 |
+ (st:deftest string-partition-as-expected-3-end () |
|
| 42 |
+ (st:should be vos-equal |
|
| 43 |
+ '("baa" "")
|
|
| 44 |
+ (partition #\d "baad"))) |
|
| 45 |
+ (st:deftest string-partition-as-expected-3-begin () |
|
| 46 |
+ (st:should be vos-equal |
|
| 47 |
+ '("" "aad")
|
|
| 48 |
+ (partition "b" "baad")))) |
|
| 49 |
+ |
|
| 8 | 50 |
(progn |
| 9 | 51 |
(st:deftest string-split-as-expected-with-test () |
| 10 | 52 |
(st:should be vos-equal |
| ... | ... |
@@ -99,7 +141,11 @@ |
| 99 | 141 |
(%split-on-char #\. "Bacon"))) |
| 100 | 142 |
) |
| 101 | 143 |
|
| 144 |
+#+nil |
|
| 102 | 145 |
(progn |
| 146 |
+ (unintern 'string-partition-as-expected-1) |
|
| 147 |
+ (unintern 'string-partition-as-expected-2) |
|
| 148 |
+ (unintern 'string-partition-as-expected-3) |
|
| 103 | 149 |
(unintern 'char-split-as-expected) |
| 104 | 150 |
(unintern 'char-split-as-expected-with-consecutive-sep) |
| 105 | 151 |
(unintern 'char-split-as-expected-with-test) |