sequences.extras: adding a version of filter that uses an elements index.

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 61f40d7378372e2b184bf11c7ff7039d5d27ad33..27e73e954bc1fc5551e86fbf1cd38a81614cfa5b 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -31,3 +31,5 @@ IN: sequences.extras.tests
 [ { 0 1 0 1 } ] [
     { 0 0 0 0 } { 1 3 } over [ 1 + ] change-nths
 ] unit-test
+
+[ { 1 3 5 } ] [ { 1 2 3 4 5 6 } [ nip even? ] filter-index ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 8cbe93e89ae9fb733cee8920410ba6a47b24f4cd..1a5fd293b6398a1c8a23543f373fc3b4d007aaa1 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -69,3 +69,15 @@ IN: sequences.extras
 
 : change-nths ( ... indices seq quot: ( ... elt -- ... elt' ) -- ... )
     [ change-nth ] 2curry each ; inline
+
+: push-if-index ( ..a elt i quot: ( ..a elt i -- ..b ? ) accum -- ..b )
+    [ 2keep drop ] dip rot [ push ] [ 2drop ] if ; inline
+
+: index-selector-for ( quot exemplar -- selector accum )
+    [ length ] keep new-resizable [ [ push-if-index ] 2curry ] keep ; inline
+
+: filter-index-as ( ... seq quot: ( ... elt i -- ... ? ) exemplar -- ... seq' )
+    dup [ index-selector-for [ each-index ] dip ] curry dip like ; inline
+
+: filter-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... seq' )
+    over filter-index-as ; inline