split1-last-slice
split
split-when
+ split*
+ split*-when
}
"Splitting a string into lines:"
{ $subsections string-lines } ;
{ $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 } "." } ;
-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
[ "" 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
: 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