diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index f44462bb68..8cfa96995e 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -58,6 +58,7 @@ IN: sequences.extras.tests { { } } [ { } [ ] map-concat ] unit-test { V{ 0 0 1 0 1 2 } } [ 4 iota [ iota ] map-concat ] unit-test { "abc" } [ "abc" [ 1string ] map-concat ] unit-test +{ "abc" } [ { 97 98 99 } [ 1string ] map-concat ] unit-test { { 97 98 99 } } [ "abc" [ 1string ] { } map-concat-as ] unit-test { { } } [ { } [ ] [ even? ] map-filter ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index fa430058ee..4a824b477c 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -130,13 +130,21 @@ IN: sequences.extras : map-concat-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq ) dup [ appender-for [ each ] dip ] curry dip like ; inline -: map-concat ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq ) - over map-concat-as ; inline +: >resizable ( seq -- vec ) ! fixes map-concat "cannot apply call to run-time..." + [ length ] keep [ new-resizable ] [ over push-all ] bi ; -: map-filter-as ( ... seq quot: ( ... elt -- ... newelt ) quot: ( ... newelt -- ... ? ) exemplar -- ... subseq ) +: map-concat ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq ) + over [ 2drop { } ] [ + first over call dup [ + >resizable [ [ push-all ] curry compose ] keep + [ 1 ] 3dip [ (each) (each-integer) ] dip + ] curry dip like + ] if-empty ; inline + +: map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq ) dup [ selector-for [ compose each ] dip ] curry dip like ; inline -: map-filter ( ... seq quot: ( ... elt -- ... newelt ) quot: ( ... newelt -- ... ? ) -- ... subseq ) +: map-filter ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) -- ... subseq ) pick map-filter-as ; inline : map-sift ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )