From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 28 Jun 2019 18:27:23 +0000 (-0700)
Subject: sequences.extras: adding extract!.
X-Git-Tag: 0.99~3808
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=81f2e9a0a7db8af67bb7c8c085e952df22ae9774

sequences.extras: adding extract!.

It's similar to reject! but returns the items that were removed.
---

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index aec14a8dc6..762660f9cf 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -281,3 +281,5 @@ tools.test vectors vocabs ;
 { 0 } [ { 1 2 3 4 } [ 5 > ] count-tail ] unit-test
 { 2 } [ { 1 2 3 4 } [ 2 > ] count-tail ] unit-test
 { 4 } [ { 1 2 3 4 } [ 5 < ] count-tail ] unit-test
+
+{ SBUF" aco" SBUF" ftr"  } [ SBUF" factor" dup [ even? ] extract! ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index cb75baa409..26b343bc7b 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -649,3 +649,7 @@ PRIVATE>
 
 : interleaved ( seq glue -- newseq )
     over interleaved-as ;
+
+: extract! ( ... seq quot: ( ... elt -- ... ? ) -- ... seq )
+    [ dup ] compose over [ length ] keep new-resizable
+    [ [ push-if ] 2curry reject! ] keep swap like ; inline