sequences: adding reject/reject-as/reject!.

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index c28b7dcaaaedeb97fd0a41dda8b8b2f6b4d79dd0..b8f59d7f6ea1206bf024d505e78a854f2c1ff559 100644 (file)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -513,6 +513,19 @@ HELP: filter!
 { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
 { $side-effects "seq" } ;
 
+HELP: reject
+{ $values { "seq" sequence } { "quot" { $quotation ( ... elt -- ... ? ) } } { "subseq" "a new sequence" } }
+{ $description "Applies the quotation to each element in turn, and outputs a new sequence removing with the elements of the original sequence for which the quotation output a true value." } ;
+
+HELP: reject-as
+{ $values { "seq" sequence } { "quot" { $quotation ( ... elt -- ... ? ) } } { "exemplar" sequence } { "subseq" "a new sequence" } }
+{ $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " remove the elements of the original sequence for which the quotation output a true value." } ;
+
+HELP: reject!
+{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation ( ... elt -- ... ? ) } } }
+{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a true value." }
+{ $side-effects "seq" } ;
+
 HELP: interleave
 { $values { "seq" sequence } { "between" quotation } { "quot" { $quotation ( ... elt -- ... ) } } }
 { $description "Applies " { $snippet "quot" } " to each element in turn, also invoking " { $snippet "between" } " in-between each pair of elements." }

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 5b05b4ef30d1573f0c285c581b133e576a99c5c5..c97a5a5c689b61db93c8a2c35605a7015f6cc724 100644 (file)
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -117,6 +117,8 @@ IN: sequences.tests
 { t } [ B{ 0 } { 1 } append byte-array? ] unit-test
 { t } [ B{ 0 } { 1 } prepend byte-array? ] unit-test
 
+{ "0123456789" } [ 58 iota [ 48 < ] "" reject-as ] unit-test
+
 [ [ ]       ] [ 1 [ ]           remove ] unit-test
 [ [ ]       ] [ 1 [ 1 ]         remove ] unit-test
 [ [ 3 1 1 ] ] [ 2 [ 3 2 1 2 1 ] remove ] unit-test
@@ -152,6 +154,8 @@ IN: sequences.tests
 [ 4 [ CHAR: a <string> ] { } map-integers ]
 unit-test
 
+{ V{ 1 3 5 7 9 } } [ 10 iota >vector [ even? ] reject! ] unit-test
+
 [ V{ } ] [ "f" V{ } clone remove! ] unit-test
 [ V{ } ] [ "f" V{ "f" } clone remove! ] unit-test
 [ V{ } ] [ "f" V{ "f" "f" } clone remove! ] unit-test

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index a17d645013865b5d0c1cfd735b1db055a029df34..bb132b8e5b1cca09d7e5390a3248a3bb0ac611da 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -544,6 +544,12 @@ PRIVATE>
 : filter ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
     over filter-as ; inline
 
+: reject-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... subseq )
+    [ [ not ] compose ] [ filter-as ] bi* ; inline
+
+: reject ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
+    over reject-as ; inline
+
 : push-either ( ..a elt quot: ( ..a elt -- ..b ? ) accum1 accum2 -- ..b )
     [ keep swap ] 2dip ? push ; inline
 
@@ -630,16 +636,16 @@ PRIVATE>
     [ eq? ] with any? ;
 
 : remove ( elt seq -- newseq )
-    [ = not ] with filter ;
+    [ = ] with reject ;
 
 : remove-eq ( elt seq -- newseq )
-    [ eq? not ] with filter ;
+    [ eq? ] with reject ;
 
 : sift ( seq -- newseq )
     [ ] filter ;
 
 : harvest ( seq -- newseq )
-    [ empty? not ] filter ;
+    [ empty? ] reject ;
 
 <PRIVATE
 
@@ -704,11 +710,14 @@ PRIVATE>
 : filter! ( ... seq quot: ( ... elt -- ... ? ) -- ... seq )
     swap [ [ 0 0 ] dip (filter!) ] keep ; inline
 
+: reject! ( ... seq quot: ( ... elt -- ... ? ) -- ... seq )
+    [ not ] compose filter! ; inline
+
 : remove! ( elt seq -- seq )
-    [ = not ] with filter! ;
+    [ = ] with reject! ;
 
 : remove-eq! ( elt seq -- seq )
-    [ eq? not ] with filter! ;
+    [ eq? ] with reject! ;
 
 : prefix ( seq elt -- newseq )
     over [ over length 1 + ] dip [

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 912f55074dad593111aa9341b39858de9b80af2b..b7c705848b572066511b23063b86fd0bea9f5107 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -170,9 +170,6 @@ IN: sequences.extras.tests
 { 0 "chicken" } [ { "chicken" "beef" "moose" } [ length ] supremum-by* ] unit-test
 { 2 "moose" } [ { "chicken" "beef" "moose" } [ first ] supremum-by* ] unit-test
 
-{ "0123456789" } [ 58 iota [ 48 < ] "" reject-as ] unit-test
-{ V{ 1 3 5 7 9 } } [ 10 iota >vector [ even? ] reject! ] unit-test
-
 { 3/10 } [ 10 iota [ 3 < ] count* ] unit-test
 
 { { 0 } } [ "ABA" "ABABA" start-all ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index abb54dd0ca1311124a340ddd210336a74124a0ba..f3a7d10fb6b777803aa04ad2a56fb98286996fa8 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -507,15 +507,6 @@ PRIVATE>
 : infimum-by* ( ... seq quot: ( ... elt -- ... x ) -- ... i elt )
     [ before? ] select-by* ; inline
 
-: reject-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... subseq )
-    [ [ not ] compose ] [ filter-as ] bi* ; inline
-
-: reject ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
-    over reject-as ; inline
-
-: reject! ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
-    [ not ] compose filter! ; inline
-
 : change-last ( seq quot -- )
     [ drop length 1 - ] [ change-nth ] 2bi ; inline