sequences: add 2filter 2reject

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index d2d6c2640fc83481a4104f031eb935b0b275812d..6c3f91024860c5c2c5145eda9dfbb9b494d544a1 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -671,6 +671,9 @@ PRIVATE>
 : push-when ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
 
+: 2push-when ( ..a elt1 elt2 quot: ( ..a elt1 elt2 -- ..b ? ) accum -- ..b )
+    [ keepd ] dip rot [ push ] [ 2drop ] if ; inline
+
 : call-push-when ( ..a elt quot: ( ..a elt -- ..b elt' ? ) accum -- ..b )
     [ call ] dip swap [ push ] [ 2drop ] if ; inline
 
@@ -679,6 +682,9 @@ PRIVATE>
 : (selector-as) ( quot length exemplar -- selector accum )
     new-resizable [ [ push-when ] 2curry ] keep ; inline
 
+: (2selector-as) ( quot length exemplar -- selector accum )
+    new-resizable [ [ 2push-when ] 2curry ] keep ; inline
+
 PRIVATE>
 
 : selector-as ( quot exemplar -- selector accum )

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 71a3beb15ac56ee1865a50aa56ab9e7f76d03941..151c190d8499686e595816dfc05ec70c427c89fe 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -343,6 +343,21 @@ PRIVATE>
 : filter-map ( ... seq filter-quot: ( ... elt -- ... ? ) map-quot: ( ... elt -- ... newelt ) -- ... newseq )
     pick filter-map-as ; inline
 
+: 2filter-as ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) exemplar -- ... newseq )
+    [
+        pick [ length ] keep
+        [ (2selector-as) [ 2each ] dip ] 2curry call
+    ] dip like ; inline
+
+: 2filter ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) -- ... newseq )
+    pick 2filter-as ; inline
+
+: 2reject-as ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) exemplar -- ... newseq )
+    [ [ not ] compose ] dip 2filter-as ; inline
+
+: 2reject ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) -- ... newseq )
+    pick 2reject-as ; inline
+
 : 2map-sum ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... n ) -- ... n )
     [ 0 ] 3dip [ dip + ] curry [ rot ] prepose 2each ; inline