sequences.extras: fix map-concat row-polymorphic problem.

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index d057fe7cf1da9c36158d008a8b1486b854d0e8a7..1af4dd809d7a1590f5eae0c05815089ba4a4adcf 100644 (file)
--- 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 bef74b6c5bb714d8bfbb9c31fbb691b3a0262d03..6feef5548acd3d035667f0836add2c168cef2213 100644 (file)
--- 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