From 81f2e9a0a7db8af67bb7c8c085e952df22ae9774 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 28 Jun 2019 11:27:23 -0700 Subject: [PATCH] sequences.extras: adding extract!. It's similar to reject! but returns the items that were removed. --- extra/sequences/extras/extras-tests.factor | 2 ++ extra/sequences/extras/extras.factor | 4 ++++ 2 files changed, 6 insertions(+) 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 -- 2.34.1