splitting.extras: improve split-harvest.

diff --git a/extra/splitting/extras/extras-tests.factor b/extra/splitting/extras/extras-tests.factor
index 75b62958c9b621c7862be19de4b6269c88dca739..a7292951fb49fffe22f013549af6292a276beb49 100644 (file)
--- a/extra/splitting/extras/extras-tests.factor
+++ b/extra/splitting/extras/extras-tests.factor
@@ -26,6 +26,8 @@ tools.test ;
 ] unit-test
 
 { { } } [ "" " " split-harvest ] unit-test
+{ { } } [ " " " " split-harvest ] unit-test
+{ { } } [ "  " " " split-harvest ] unit-test
 { { "a" } } [ "a" " " split-harvest ] unit-test
 { { "a" } } [ " a" " " split-harvest ] unit-test
 { { "a" } } [ " a " " " split-harvest ] unit-test

diff --git a/extra/splitting/extras/extras.factor b/extra/splitting/extras/extras.factor
index 5f2a6c2b95128e91a0a3ca0f66cd8e11a40c4cff..8ce45bac62f17e72bcdc52ea6c1aa3a5f7e11a5e 100644 (file)
--- a/extra/splitting/extras/extras.factor
+++ b/extra/splitting/extras/extras.factor
@@ -46,19 +46,16 @@ PRIVATE>
 
 <PRIVATE
 
-: (split-harvest) ( seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
-    [ [ [ not ] compose find drop 0 or ] 2keep ] dip [
-        drop
-        dupd [ find-from drop ] 2curry [ 1 + ] prepose
-        [ keep swap ] curry
-        swap [ length 2dup >= [ drop f ] when ] curry
-        [ unless* ] curry compose
-        [ [ dup ] if dup ] curry [ dup ] prepose
+:: (split-harvest) ( seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
+    seq [ quot call not ] find drop [
+        [
+            [ seq quot find-from drop ] keep swap
+            [ seq length ] unless* dup
+        ] [ f f f ] if*
     ] [
-        pick swap curry [ keep swap ] curry -rot
-        [ not ] compose [ find-from drop ] 2curry
-        [ 1 + ] prepose [ dip ] curry compose
-    ] 3bi produce 2nip ; inline
+        [ seq slice-quot call ] keep swap
+        [ 1 + seq [ quot call not ] find-from drop ] dip
+    ] produce 2nip ; inline
 
 PRIVATE>