steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2013-05-30 14:54:29 -07:00
parent eaea33b28e
commit f628e2a7ad
2 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/sequences/extras/extras-tests.factor
View File

@ -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

12
extra/sequences/extras/extras.factor
View File

@ -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