From 6d00bd9737efb0c0dfe70ba5279f97406b2db2cb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 25 Aug 2022 19:02:41 -0400
Subject: [PATCH] sequences: add 2filter 2reject

---
 core/sequences/sequences.factor      |  6 ++++++
 extra/sequences/extras/extras.factor | 15 +++++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index d2d6c2640f..6c3f910248 100644
--- 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 71a3beb15a..151c190d84 100644
--- 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
 
-- 
2.34.1