splitting: change split* to preserve (separately) the separators.

diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor
index ff7dc77ac29342aa97ea690576b2eb1d47b155f6..458cb707a6553675f06ef734f3a563ba223e55c5 100644 (file)
--- a/core/splitting/splitting-docs.factor
+++ b/core/splitting/splitting-docs.factor
@@ -70,12 +70,12 @@ HELP: split
 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\" }" } } ;
+{ $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?\" }" } } ;
+{ $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" } }

diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor
index a8c506f92d6955658c2e5dd6ac77af0f85ffa53d..e27e8db34079670b583f736876796b5062b91bc8 100644 (file)
--- a/core/splitting/splitting-tests.factor
+++ b/core/splitting/splitting-tests.factor
@@ -72,6 +72,10 @@ unit-test
 
 [ { "hey" "world" "what's" "happening" } ]
 [ "heyAworldBwhat'sChappening" [ LETTER? ] split-when ] unit-test
+{ { { 2 } { 3 } { 5 1 } { 7 } } } [
+    1 { 2 1 3 2 5 1 3 7 }
+    [ dupd = dup [ [ 1 + ] dip ] when ] split-when nip
+] unit-test
 
 [ { "hey" "world" "what's" "happening" } ]
 [
@@ -90,13 +94,17 @@ 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 0 } } } [ { 0 0 } { 0 } split* ] unit-test
+{ { { 1 2 } { 0 } { 3 } { 0 0 } } } [ { 1 2 0 3 0 0 } { 0 } split* ] unit-test
+{ { "hello" } } [ "hello" " " split* ] unit-test
+{ { "  " "hello" } } [ "  hello" " " split* ] unit-test
+{ { "hello" "    " "world" } } [ "hello    world" " " split* ] unit-test
+{ { "hello" "    " "world" "    " } } [ "hello    world    " " " 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
+{ { { 1 2 } { 0 } { 3 } { 0 0 } } } [ { 1 2 0 3 0 0 } [ 0 > ] split*-when ] unit-test
 
 { "abarbbarc" }
 [ "afoobfooc" "foo" "bar" replace ] unit-test

diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 9cebb73a0b0c6c293b7a4087233136ce87ece5ac..eb0d2c5bb0e4f9c7d2fc3af589982213e22a13a8 100644 (file)
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -26,7 +26,7 @@ PRIVATE>
 
 <PRIVATE
 
-: (split1) ( seq subseq quot -- before after )
+: (split1) ( seq subseq snip-quot -- before after )
     [
         swap [
             [ drop length ] [ start dup ] 2bi
@@ -56,7 +56,7 @@ PRIVATE>
 
 <PRIVATE
 
-: (split1-when) ( ... seq quot: ( ... elt -- ... ? ) quot -- ... before-slice after-slice )
+: (split1-when) ( ... seq quot: ( ... elt -- ... ? ) snip-quot -- ... before-slice after-slice )
     [ dupd find drop ] dip [ swap [ dup 1 + ] dip ] prepose [ f ] if* ; inline
 
 PRIVATE>
@@ -77,12 +77,14 @@ PRIVATE>
 
 <PRIVATE
 
-: (split) ( n seq quot: ( ... elt -- ... ? ) quot -- pieces )
+: (split) ( n seq quot: ( ... elt -- ... ? ) slice-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
+        swap curry [ keep 1 + swap ] curry [
+            [ find-from drop dup ] 2curry [ keep -rot ] curry
+        ] dip produce nip
+    ] 2keep swap [
+        [ length swapd ] keep
+    ] dip 2curry call suffix ; inline
 
 PRIVATE>
 
@@ -100,14 +102,18 @@ PRIVATE>
 
 <PRIVATE
 
-: (split*) ( n seq quot: ( ... elt -- ... ? ) quot -- )
+: (split*) ( n seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
     pick [
-        swap curry [ 1 + ] prepose [ keep 1 + swap ] curry
-        [ [ find-from drop dup ] 2curry [ dup ] prepose ] dip
-        produce nip
-    ] keep rot over dupd length < [
-        [ tail ] unless-zero suffix
-    ] [ 2drop ] if ; inline
+        swap curry [ keep swap ] curry [
+            [ [ find-from drop dup ] 2curry [ keep -rot ] curry ] 2keep
+            [ not ] compose [ find-from drop dup ] 2curry
+            [ dip -rot ] curry [ swap ] prepose
+            [ [ dup ] if ] curry [ 2dup = ] prepose
+            [ [ f ] if ] curry compose
+        ] dip produce nip
+    ] 2keep swap [
+        [ length [ swapd dupd < ] keep ] keep
+    ] dip 2curry [ suffix ] compose [ drop ] if ; inline
 
 PRIVATE>