From f628e2a7ad10934a6611365c4de7b02228a84285 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 30 May 2013 14:54:29 -0700 Subject: [PATCH] sequences.extras: fix map-concat row-polymorphic problem. --- extra/sequences/extras/extras-tests.factor | 2 ++ extra/sequences/extras/extras.factor | 12 ++++++------ 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index d057fe7cf1..1af4dd809d 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -59,6 +59,8 @@ IN: sequences.extras.tests { "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 +{ "baz" { "foobaz" "barbaz" } } +[ "baz" { { "foo" } { "bar" } } [ [ over append ] map ] map-concat ] unit-test { { } } [ { } [ ] [ even? ] map-filter ] unit-test { "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index bef74b6c5b..6feef5548a 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -172,18 +172,18 @@ PRIVATE> V{ } appender-for ; inline : map-concat-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq ) - pick length over [ (appender-for) [ each ] dip ] 2curry dip like ; inline + [ appender-for [ each ] dip ] keep like ; inline -: >resizable ( seq -- accum ) ! fixes map-concat "cannot apply call to run-time..." - [ length ] keep [ new-resizable ] [ over push-all ] bi ; +: >resizable ( seq -- accum ) + [ length ] keep [ new-resizable ] [ over push-all ] bi ; inline : map-concat ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq ) - over [ 2drop { } ] [ - first over call dup [ + over empty? [ 2drop { } ] [ + [ [ first ] dip call ] 2keep rot dup [ >resizable [ [ push-all ] curry compose ] keep [ 1 ] 3dip [ (each) (each-integer) ] dip ] curry dip like - ] if-empty ; inline + ] if ; inline : map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq ) [ pick ] dip swap length over