diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 61f40d7378..27e73e954b 100644 --- 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 8cbe93e89a..1a5fd293b6 100644 --- 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