sequences.extras: adding "filter-map".

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 8cfa96995e643d198345c704068884f789371c1f..1b58c180b73a5c2b4f10c0a29182c605087e33b0 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -64,3 +64,6 @@ IN: sequences.extras.tests
 { { } } [ { } [ ] [ even? ] map-filter ] unit-test
 { "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test
 { { 0 4 16 36 64 } } [ 10 iota [ sq ] [ even? ] { } map-filter-as ] unit-test
+
+{ V{ 0 4 16 36 64 } } [ 10 iota [ even? ] [ sq ] filter-map ] unit-test
+{ { 2 6 10 14 18 } } [ 10 iota [ odd? ] [ 2 * ] { } filter-map-as ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 4a824b477cf2f47aab8a74fcdf6ade9a5eb3445b..db0860104584c4048117d9b9cbbea92b60b33064 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -152,3 +152,22 @@ IN: sequences.extras
 
 : map-harvest ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     [ empty? not ] map-filter ; inline
+
+<PRIVATE
+
+: push-map-if ( ..a elt filter-quot: ( ..a elt -- ..b ? ) map-quot: ( ..a elt -- ..b newelt ) accum -- ..b )
+    [ keep over ] 2dip [ when ] dip rot [ push ] [ 2drop ] if ; inline
+
+: filter-mapper-for ( filter-quot map-quot exemplar -- quot' vec )
+    [ length ] keep new-resizable [ [ push-map-if ] 3curry ] keep ; inline
+
+: filter-mapper ( filter-quot map-quot -- quot' vec )
+    V{ } filter-mapper-for ; inline
+
+PRIVATE>
+
+: filter-map-as ( ... seq filter-quot: ( ... elt -- ... ? ) map-quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
+    dup [ filter-mapper-for [ each ] dip ] curry dip like ; inline
+
+: filter-map ( ... seq filter-quot: ( ... elt -- ... ? ) map-quot: ( ... elt -- ... newelt ) -- ... newseq )
+    pick filter-map-as ; inline