add filter-as to sequences

core/sequences/sequences-docs.factor

@@ -426,6 +426,10 @@ HELP: filter
 { $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "subseq" "a new sequence" } }
 { $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
 
+HELP: filter-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" } " containing the elements of the original sequence for which the quotation output a true value." } ;
+
 HELP: filter-here
 { $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 false value." }
@@ -1512,6 +1516,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
 "Filtering:"
 { $subsections
     filter
+    filter-as
     partition
 }
 "Testing if a sequence contains elements satisfying a predicate:"

core/sequences/sequences.factor

@@ -483,11 +483,17 @@ PRIVATE>
 : push-if ( elt quot accum -- )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
 
+: pusher-for ( quot exemplar -- quot accum )
+    [ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline
+
 : pusher ( quot -- quot accum )
-    V{ } clone [ [ push-if ] 2curry ] keep ; inline
+    V{ } pusher-for ; inline
+
+: filter-as ( seq quot exemplar -- subseq )
+    dup [ pusher-for [ each ] dip ] curry dip like ; inline
 
 : filter ( seq quot -- subseq )
-    over [ pusher [ each ] dip ] dip like ; inline
+    over filter-as ; inline
 
 : push-either ( elt quot accum1 accum2 -- )
     [ keep swap ] 2dip ? push ; inline