sequences.extras: Add selector* which saves the output from the quotation

not the original value.

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index b7c705848b572066511b23063b86fd0bea9f5107..83bef71849699c39710d1b010abdd8a8912a0394 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -26,6 +26,10 @@ IN: sequences.extras.tests
     { 0 0 0 0 } { 1 3 } over [ 1 + ] change-nths
 ] unit-test
 
+{ V{ f t f } } [
+    { 1 2 3 } [ even? ] selector* [ each ] dip
+] unit-test
+
 [ { 1 3 5 } ] [ { 1 2 3 4 5 6 } [ nip even? ] filter-index ] unit-test
 
 [ V{ 1 3 5 } ] [ { 1 2 3 4 5 6 } [ nip even? ] V{ } filter-index-as ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index a925ed8188d10ebdf02a5ae0c8824fd483ad96c9..21450c05513ee76b39f94a96e04c52868315a58f 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -92,11 +92,17 @@ IN: sequences.extras
 : push-if-index ( ..a elt i quot: ( ..a elt i -- ..b ? ) accum -- ..b )
     [ 2keep drop ] dip rot [ push ] [ 2drop ] if ; inline
 
+: push-if* ( ..a elt quot: ( ..a elt -- ..b obj/f ) accum -- ..b )
+    [ call ] dip [ push ] [ drop ] if* ; inline
+
 <PRIVATE
 
 : (index-selector-for) ( quot length exampler -- selector accum )
     new-resizable [ [ push-if-index ] 2curry ] keep ; inline
 
+: (selector-for*) ( quot length exemplar -- selector accum )
+    new-resizable [ [ push-if* ] 2curry ] keep ; inline
+
 PRIVATE>
 
 : index-selector-for ( quot exemplar -- selector accum )
@@ -105,6 +111,11 @@ PRIVATE>
 : index-selector ( quot -- selector accum )
     V{ } index-selector-for ; inline
 
+: selector-for* ( quot exemplar -- selector accum )
+    [ length ] keep (selector-for*) ; inline
+
+: selector* ( quot -- selector accum ) V{ } selector-for* ; inline
+
 : filter-index-as ( ... seq quot: ( ... elt i -- ... ? ) exemplar -- ... seq' )
     pick length over [ (index-selector-for) [ each-index ] dip ] 2curry dip like ; inline