factor "split-when" (split on predicate) from "split"

diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor
index 10fea15a6499bf082571d87bb2ead8401919d3e3..50855713121181367d318f1c2bb49efafce9ce1c 100644 (file)
--- a/core/splitting/splitting-docs.factor
+++ b/core/splitting/splitting-docs.factor
@@ -13,6 +13,7 @@ ARTICLE: "sequences-split" "Splitting sequences"
     split1-last
     split1-last-slice
     split
+    split-when
 }
 "Splitting a string into lines:"
 { $subsections string-lines } ;
@@ -37,9 +38,14 @@ HELP: split1-last-slice
 
 { split1 split1-slice split1-last split1-last-slice } related-words
 
+HELP: split-when
+{ $values { "seq" "a sequence" } { "quot" { $quotation "( elt -- ? )" } } { "pieces" "a new array" } }
+{ $description "Splits " { $snippet "seq" } " at each occurrence of an element for which " { $snippet "quot" } " gives a true output and outputs an array of pieces. The pieces do not include the elements along which the sequence was split." }
+{ $examples { $example "USING: ascii kernel prettyprint splitting ;" "\"hello,world-how.are:you\" [ letter? not ] split-when ." "{ \"hello\" \"world\" \"how\" \"are\" \"you\" }" } } ;
+
 HELP: split
 { $values { "seq" "a sequence" } { "separators" "a sequence" } { "pieces" "a new array" } }
-{ $description "Splits " { $snippet "seq" } " at each occurrence of an element of " { $snippet "separators" } ", and outputs an array of pieces. The pieces do not include the elements along which the sequence was split." }
+{ $description "Splits " { $snippet "seq" } " at each occurrence of an element of " { $snippet "separators" } " and outputs an array of pieces. The pieces do not include the elements along which the sequence was split." }
 { $examples { $example "USING: prettyprint splitting ;" "\"hello world-how are you?\" \" -\" split ." "{ \"hello\" \"world\" \"how\" \"are\" \"you?\" }" } } ;
 
 HELP: ?head

diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor
index ed68038fa6ddc5579c48fc0c93cda31cec0772ac..e672624d9677363893a7704648b205b431f761c6 100644 (file)
--- a/core/splitting/splitting-tests.factor
+++ b/core/splitting/splitting-tests.factor
@@ -1,4 +1,4 @@
-USING: splitting tools.test kernel sequences arrays strings ;
+USING: splitting tools.test kernel sequences arrays strings ascii ;
 IN: splitting.tests
 
 [ "hello" "world ." ] [ "hello world ." " " split1 ] unit-test
@@ -57,3 +57,6 @@ unit-test
 [ { "hello" "hi" } ] [ "hello\nhi" string-lines ] unit-test
 [ { "hello" "hi" } ] [ "hello\rhi" string-lines ] unit-test
 [ { "hello" "hi" } ] [ "hello\r\nhi" string-lines ] unit-test
+
+[ { "hey" "world" "what's" "happening" } ]
+[ "heyAworldBwhat'sChappening" [ LETTER? ] split-when ] unit-test

diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 7aae30f20b356667fab9f1ef25ee456ff7ecc93d..7b805dffe55a2b169b87821c5329e4ae2a36eb2d 100644 (file)
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -55,17 +55,21 @@ PRIVATE>
 
 <PRIVATE
 
-: (split) ( separators n seq -- )
-    3dup rot [ member? ] curry find-from drop
-    [ [ swap subseq , ] 2keep 1 + swap (split) ]
-    [ swap [ tail ] unless-zero , drop ] if* ; inline recursive
+: (split) ( n seq quot: ( elt -- ? ) -- )
+    [ find-from drop ]
+    [ [ [ 3dup swapd subseq , ] dip [ drop 1 + ] 2dip (split) ] 3curry ]
+    [ drop [ swap [ tail ] unless-zero , ] 2curry ]
+    3tri if* ; inline recursive
 
-: split, ( seq separators -- ) 0 rot (split) ;
+: split, ( seq quot -- ) [ 0 ] 2dip (split) ; inline
 
 PRIVATE>
 
 : split ( seq separators -- pieces )
-    [ split, ] { } make ;
+    [ [ member? ] curry split, ] { } make ;
+
+: split-when ( seq quot -- pieces )
+    [ split, ] { } make ; inline
 
 GENERIC: string-lines ( str -- seq )