sequences.extras: Add 2map-filter and variants where the second sequence

[factor.git] / extra / sequences / extras / extras.factor

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 83320228b9288d56074fd17836a59cb22ca83afa..b6a3bb2c83cbc13486fb6244fe7f3ad0b2f24b80 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -75,6 +75,9 @@ IN: sequences.extras
 : push-if* ( ..a elt quot: ( ..a elt -- ..b obj/f ) accum -- ..b )
     [ call ] dip [ push ] [ drop ] if* ; inline
 
+: push? ( elt/f accum -- )
+    over [ push ] [ 2drop ] if ; inline
+
 <PRIVATE
 
 : (index-selector-as) ( quot length exampler -- selector accum )
@@ -784,11 +787,57 @@ M: step-slice length
 
 INSTANCE: step-slice virtual-sequence
 
+: 2nested-each* ( seq1 seq-quot: ( n -- seq ) quot: ( a b -- ) -- )
+    '[
+        _ keep swap _ with each
+    ] each ; inline
+
+: 2nested-filter-as* ( seq1 seq-quot quot exemplar -- seq )
+    [ 2over [ length ] bi@ * ] dip
+    [
+        new-resizable
+        [ [ push? ] curry compose 2nested-each* ] keep
+    ] keep like ; inline
+
+: 2nested-filter* ( seq1 seq-quot quot -- seq )
+    pick 2nested-filter-as* ; inline
+
+: 2nested-map-as* ( seq1 seq-quot quot exemplar -- seq )
+    [ 2over [ length ] bi@ * ] dip
+    [
+        new-resizable
+        [ [ push ] curry compose 2nested-each* ] keep
+    ] keep like ; inline
+
+: 2nested-map* ( seq1 seq-quot quot -- seq )
+    pick 2nested-map-as* ; inline
+
+
 : 2nested-each ( seq1 seq2 quot -- )
     swapd '[
         swap _ with each
     ] with each ; inline
 
+: 2nested-filter-as ( seq1 seq2 quot exemplar -- seq )
+    [ 2over [ length ] bi@ * ] dip
+    [
+        new-resizable
+        [ [ push? ] curry compose 2nested-each ] keep
+    ] keep like ; inline
+
+: 2nested-filter ( seq1 seq2 quot -- seq )
+    pick 2nested-filter-as ; inline
+
+: 2nested-map-as ( seq1 seq2 quot exemplar -- seq )
+    [ 2over [ length ] bi@ * ] dip
+    [
+        new-resizable
+        [ [ push ] curry compose 2nested-each ] keep
+    ] keep like ; inline
+
+: 2nested-map ( seq1 seq2 quot -- seq )
+    pick 2nested-map-as ; inline
+
 : 3nested-each ( seq1 seq2 seq3 quot -- )
     [ spin ] dip '[
         -rot [
@@ -796,20 +845,26 @@ INSTANCE: step-slice virtual-sequence
         ] with with each
     ] with with each ; inline
 
-: 2nested-map ( seq1 seq2 quot -- seq )
-    2over [ length ] bi@ * reach
+: 3nested-filter-as ( seq1 seq2 seq3 quot exemplar -- seq )
+    [ 3 nover [ length ] tri@ * * ] dip
     [
         new-resizable
-        [ [ push ] curry compose 2nested-each ] keep
+        [ [ push? ] curry compose 3nested-each ] keep
     ] keep like ; inline
 
-: 3nested-map ( seq1 seq2 seq3 quot -- seq )
-    3 nover [ length ] tri@ * * 5 npick
+: 3nested-filter ( seq1 seq2 seq3 quot -- seq )
+    reach 3nested-filter-as ; inline
+
+: 3nested-map-as ( seq1 seq2 seq3 quot exemplar -- seq )
+    [ 3 nover [ length ] tri@ * * ] dip
     [
         new-resizable
         [ [ push ] curry compose 3nested-each ] keep
     ] keep like ; inline
 
+: 3nested-map ( seq1 seq2 seq3 quot -- seq )
+    reach 3nested-map-as ; inline
+
 : prev ( n seq -- obj ) [ 1 - ] dip nth ; inline
 : ?prev ( n seq -- obj/f ) [ 1 - ] dip ?nth ; inline
 : ??prev ( n seq -- obj/f ? ) [ 1 - ] dip ??nth ; inline