splitting: adding split1-when-slice and split-when-slice.

diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor
index c0563b40875aa8656cf37a26b288dcb8ca9404c0..ff7dc77ac29342aa97ea690576b2eb1d47b155f6 100644 (file)
--- 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 550cb00b1f4fca94b398f3cef6cdf8ddc2729be3..a8c506f92d6955658c2e5dd6ac77af0f85ffa53d 100644 (file)
--- 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 2498984354bca14c60cfb9212334406a35806ba4..39ca33bd409d473a2d5bc522cf6de52e0e5c0d7d 100644 (file)
--- 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 ;
+
+<PRIVATE
+
+: (split1-when) ( ... seq quot: ( ... elt -- ... ? ) quot -- ... before-slice after-slice )
+    [ dupd find drop ] dip [ swap [ dup 1 + ] dip ] prepose [ f ] if* ; inline
+
+PRIVATE>
+
 : 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 )
     [ <reversed> ] bi@ split1 [ reverse ] bi@
@@ -62,26 +75,25 @@ PRIVATE>
     [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
     [ f ] [ swap ] if-empty ;
 
-: replace ( seq old new -- new-seq )
-    pick [ [ split-subseq ] dip ] dip join-as ;
-
 <PRIVATE
 
-: (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 quot: ( ... elt -- ... ? ) -- ... ) [ 0 ] 2dip (split) ; inline
+: (split) ( n seq quot: ( ... elt -- ... ? ) quot -- pieces )
+    pick [
+        swap curry [ keep 1 + swap ] curry
+        [ [ find-from drop dup ] 2curry [ dup ] prepose ] dip
+        produce nip
+    ] keep rot [ tail ] unless-zero suffix ; inline
 
 PRIVATE>
 
-: 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 [ <slice> ] (split) ; inline
+
+: split ( seq separators -- pieces )
+    [ member? ] curry split-when ; inline
 
 <PRIVATE
 
@@ -91,7 +103,8 @@ PRIVATE>
     [ 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>