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

db4
Joe Groff 2009-11-06 16:29:33 -06:00
parent ca7f07eed9
commit 2352792502
3 changed files with 21 additions and 8 deletions

View File

@ -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

View File

@ -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

View File

@ -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 )