diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index b7c705848b..83bef71849 100644 --- 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 a925ed8188..21450c0551 100644 --- 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 + : 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