splitting: adding split*, a variant that keeps elements we split upon.

core/splitting/splitting-docs.factor

@@ -15,6 +15,8 @@ ARTICLE: "sequences-split" "Splitting sequences"
     split1-last-slice
     split
     split-when
+    split*
+    split*-when
 }
 "Splitting a string into lines:"
 { $subsections string-lines } ;
@@ -53,6 +55,16 @@ HELP: 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: split*-when
+{ $values { "seq" "a sequence" } { "quot" { $quotation "( ... elt -- ... ? )" } } { "pieces" "a new array" } }
+{ $description "A variant of " { $link split-when } " that includes 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 "A variant of " { $link split } " that includes 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
 { $values { "seq" "a sequence" } { "begin" "a sequence" } { "newseq" "a new sequence" } { "?" "a boolean" } }
 { $description "Tests if " { $snippet "seq" } " starts with " { $snippet "begin" } ". If there is a match, outputs the subrange of " { $snippet "seq" } " excluding " { $snippet "begin" } ", and " { $link t } ". If there is no match, outputs " { $snippet "seq" } " and " { $link f } "." } ;

core/splitting/splitting-tests.factor

@@ -1,4 +1,4 @@
-USING: splitting tools.test kernel sequences arrays strings ascii ;
+USING: splitting tools.test kernel sequences arrays strings ascii math ;
 IN: splitting.tests
 
 [ "hello" "world ." ] [ "hello world ." " " split1 ] unit-test
@@ -64,3 +64,14 @@ unit-test
 [ "" f ] [ "" [ blank? ] split1-when ] unit-test
 [ "" "ABC" ] [ " ABC" [ blank? ] split1-when ] unit-test
 [ "a" " bc" ] [ "a  bc" [ blank? ] split1-when ] unit-test
+
+{ { } } [ { } { 0 } split* ] unit-test
+{ { { 1 2 3 } } } [ { 1 2 3 } { 0 } split* ] unit-test
+{ { { 0 } } } [ { 0 } { 0 } split* ] unit-test
+{ { { 0 } { 0 } } } [ { 0 0 } { 0 } split* ] unit-test
+{ { { 1 2 0 } { 3 0 } { 0 } } } [ { 1 2 0 3 0 0 } { 0 } split* ] unit-test
+
+{ { } } [ { } [ 0 > ] split*-when ] unit-test
+{ { { 0 } } } [ { 0 } [ 0 > ] split*-when ] unit-test
+{ { { 0 0 } } } [ { 0 0 } [ 0 > ] split*-when ] unit-test
+{ { { 1 } { 2 } { 0 3 } { 0 0 } } } [ { 1 2 0 3 0 0 } [ 0 > ] split*-when ] unit-test

core/splitting/splitting.factor

@@ -73,6 +73,24 @@ PRIVATE>
 : split-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
     [ split, ] { } make ; inline
 
+<PRIVATE
+
+: (split*) ( n seq quot: ( ... elt -- ... ? ) -- )
+    [ find-from ]
+    [ [ [ 1 + ] 3dip [ 3dup swapd subseq , ] dip [ drop ] 2dip (split*) ] 3curry ]
+    [ drop [ [ drop ] 2dip 2dup length < [ swap [ tail ] unless-zero , ] [ 2drop ] if ] 2curry ]
+    3tri if ; inline recursive
+
+: split*, ( ... seq quot: ( ... elt -- ... ? ) -- ... ) [ 0 ] 2dip (split*) ; inline
+
+PRIVATE>
+
+: split* ( seq separators -- pieces )
+    [ [ member? ] curry split*, ] { } make ;
+
+: split*-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
+    [ split*, ] { } make ; inline
+
 GENERIC: string-lines ( str -- seq )
 
 M: string string-lines