sequences.extras: adding cut-when.

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 1af4dd809d7a1590f5eae0c05815089ba4a4adcf..0ee8e5242f096afed9277be8c16dbcdb3c21be34 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -164,3 +164,8 @@ IN: sequences.extras.tests
 { "ab" } [ f 2 "abcdef" subseq* ] unit-test
 { "cdef" } [ 2 f "abcdef" subseq* ] unit-test
 { "cd" } [ -4 -2 "abcdef" subseq* ] unit-test
+
+{ "foo" "" } [ "foo" [ blank? ] cut-when ] unit-test
+{ "foo" " " } [ "foo " [ blank? ] cut-when ] unit-test
+{ "" " foo" } [ " foo" [ blank? ] cut-when ] unit-test
+{ "foo" " bar" } [ "foo bar" [ blank? ] cut-when ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index cddaf693d3cfe6d7026fc7bf058b13908097996e..fc6e90744a4ad044ae80f733b029dd929bce5069 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -482,3 +482,7 @@ PRIVATE>
         { 3 [ first3-unsafe f ] }
         [ drop first4-unsafe ]
     } case ;
+
+: cut-when ( ... seq quot: ( ... elt -- ... ? ) -- ... before after )
+    [ find drop ] 2keep drop swap
+    [ cut ] [ f over like ] if* ; inline