]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences.extras: fixing map-concat to return type of first mapped value.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 26 Apr 2012 22:07:39 +0000 (15:07 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 26 Apr 2012 22:07:39 +0000 (15:07 -0700)
extra/sequences/extras/extras-tests.factor
extra/sequences/extras/extras.factor

index f44462bb68d080ad555023e17d512ce38e814246..8cfa96995e643d198345c704068884f789371c1f 100644 (file)
@@ -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
index fa430058ee58c5436e88b975b571cd481cd53fd1..4a824b477cf2f47aab8a74fcdf6ade9a5eb3445b 100644 (file)
@@ -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 )