diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor index c0563b4087..ff7dc77ac2 100644 --- a/core/splitting/splitting-docs.factor +++ b/core/splitting/splitting-docs.factor @@ -11,10 +11,12 @@ ARTICLE: "sequences-split" "Splitting sequences" split1 split1-slice split1-when + split1-when-slice split1-last split1-last-slice split split-when + split-when-slice split* split*-when } @@ -37,6 +39,10 @@ HELP: split1-when { $values { "seq" "a sequence" } { "quot" { $quotation "( ... elt -- ... ? )" } } { "before" "a new sequence" } { "after" "a new sequence" } } { $description "Splits " { $snippet "seq" } " at the first occurrence of an element for which " { $snippet "quot" } " gives a true output and outputs the pieces before and after the split." } ; +HELP: split1-when-slice +{ $values { "seq" "a sequence" } { "quot" { $quotation "( ... elt -- ... ? )" } } { "before-slice" slice } { "after-slice" slice } } +{ $description "Splits " { $snippet "seq" } " at the first occurrence of an element for which " { $snippet "quot" } " gives a true output and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ; + HELP: split1-last { $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } } { $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ; @@ -52,6 +58,10 @@ HELP: split-when { $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-when-slice +{ $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 as slices. The pieces do not include the elements along which the sequence was split." } ; + 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." } diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor index 550cb00b1f..a8c506f92d 100644 --- a/core/splitting/splitting-tests.factor +++ b/core/splitting/splitting-tests.factor @@ -73,10 +73,20 @@ unit-test [ { "hey" "world" "what's" "happening" } ] [ "heyAworldBwhat'sChappening" [ LETTER? ] split-when ] unit-test +[ { "hey" "world" "what's" "happening" } ] +[ + "heyAworldBwhat'sChappening" [ LETTER? ] split-when-slice + [ >string ] map +] unit-test + [ "" f ] [ "" [ blank? ] split1-when ] unit-test [ "" "ABC" ] [ " ABC" [ blank? ] split1-when ] unit-test [ "a" " bc" ] [ "a bc" [ blank? ] split1-when ] unit-test +[ "" f ] [ "" [ blank? ] split1-when-slice ] unit-test +[ "" "ABC" ] [ " ABC" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test +[ "a" " bc" ] [ "a bc" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test + { { } } [ { } { 0 } split* ] unit-test { { { 1 2 3 } } } [ { 1 2 3 } { 0 } split* ] unit-test { { { 0 } } } [ { 0 } { 0 } split* ] unit-test diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 2498984354..39ca33bd40 100644 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -51,8 +51,21 @@ PRIVATE> [ dup ] swap [ split1-slice swap ] curry produce nip ] if ; +: replace ( seq old new -- new-seq ) + pick [ [ split-subseq ] dip ] dip join-as ; + + + : split1-when ( ... seq quot: ( ... elt -- ... ? ) -- ... before after ) - dupd find drop [ swap [ dup 1 + ] dip snip ] [ f ] if* ; inline + [ snip ] (split1-when) ; inline + +: split1-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... before-slice after-slice ) + [ snip-slice ] (split1-when) ; inline : split1-last ( seq subseq -- before after ) [ ] bi@ split1 [ reverse ] bi@ @@ -62,26 +75,25 @@ PRIVATE> [ ] bi@ split1-slice [ ] bi@ [ f ] [ swap ] if-empty ; -: replace ( seq old new -- new-seq ) - pick [ [ split-subseq ] dip ] dip join-as ; - -: split ( seq separators -- pieces ) - [ [ member? ] curry split, ] { } make ; inline - : split-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces ) - [ split, ] { } make ; inline + [ 0 ] 2dip [ subseq ] (split) ; inline + +: split-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces ) + [ 0 ] 2dip [ ] (split) ; inline + +: split ( seq separators -- pieces ) + [ member? ] curry split-when ; inline [ drop [ [ drop ] 2dip 2dup length < [ swap [ tail ] unless-zero , ] [ 2drop ] if ] 2curry ] 3tri if ; inline recursive -: split*, ( ... seq quot: ( ... elt -- ... ? ) -- ... ) [ 0 ] 2dip (split*) ; inline +: split*, ( ... seq quot: ( ... elt -- ... ? ) -- ... ) + [ 0 ] 2dip (split*) ; inline PRIVATE>