splitting.extras: adding split-harvest in "core style" (ugh!).

diff --git a/extra/splitting/extras/extras-tests.factor b/extra/splitting/extras/extras-tests.factor
index fd8bd2d29756264101bbcfeae571d5f51f6384be..e36052e4dc1313afad3d60cf2a0beb093b66b30a 100644 (file)
--- a/extra/splitting/extras/extras-tests.factor
+++ b/extra/splitting/extras/extras-tests.factor
@@ -26,3 +26,16 @@ IN: splitting.extras
     [ [ blank? ] find drop ] split-find
     [ >string ] map
 ] unit-test
+
+{ { } } [ "" " " split-harvest ] unit-test
+{ { "a" } } [ "a" " " split-harvest ] unit-test
+{ { "a" } } [ " a" " " split-harvest ] unit-test
+{ { "a" } } [ " a " " " split-harvest ] unit-test
+{ { "a" "b" } } [ "a b" " " split-harvest ] unit-test
+{ { "a" "b" } } [ " a b" " " split-harvest ] unit-test
+{ { "a" "b" } } [ " a b " " " split-harvest ] unit-test
+{ { "a" "b" "c" } } [ "a b c" " " split-harvest ] unit-test
+{ { "a" "b" "c" } } [ "a  b c" " " split-harvest ] unit-test
+{ { "a" "b" "c" } } [ "a  b  c" " " split-harvest ] unit-test
+{ { "a" "b" "c" } } [ " a  b  c" " " split-harvest ] unit-test
+{ { "a" "b" "c" } } [ " a  b  c " " " split-harvest ] unit-test

diff --git a/extra/splitting/extras/extras.factor b/extra/splitting/extras/extras.factor
index 19d0fe68dcb7035bcf678ee0253691472f543dc8..98a9e0f27fad099ebeb9e0d90de712ee155a9ad0 100644 (file)
--- a/extra/splitting/extras/extras.factor
+++ b/extra/splitting/extras/extras.factor
@@ -1,4 +1,4 @@
-USING: kernel math sequences ;
+USING: kernel locals math sequences ;
 
 IN: splitting.extras
 
@@ -32,3 +32,30 @@ PRIVATE>
     [ dup empty? not ] swap [ [ dup ] ] dip
     [ [ [ 1 ] when-zero cut-slice swap ] [ f swap ] if* ] compose
     compose produce nip ; inline
+
+<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
+    ] [
+        pick swap curry [ keep swap ] curry -rot
+        [ not ] compose [ find-from drop ] 2curry
+        [ 1 + ] prepose [ dip ] curry compose
+    ] 3bi produce 2nip ; inline
+
+PRIVATE>
+
+: split-when-harvest ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
+    [ subseq ] (split-harvest) ; inline
+
+: split-when-slice-harvest ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
+    [ <slice> ] (split-harvest) ; inline
+
+: split-harvest ( seq separators -- pieces )
+    [ member? ] curry split-when-harvest ; inline