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

lists: make lmap behave row-polymorphically 

Fix contributed by @bremac. Fixes #355.
Joe Groff 2011-11-07 10:37:13 -08:00
parent cb66728b26
commit c79ef17deb
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/lists/lists-tests.factor
View File

@ -7,6 +7,10 @@ IN: lists.tests
{ 1 2 3 4 5 } sequence>list [ 2 + ] lmap list>array { 1 2 3 4 5 } sequence>list [ 2 + ] lmap list>array
] unit-test ] unit-test
{ 2 { 3 4 5 6 7 } } [
2 { 1 2 3 4 5 } sequence>list [ dupd + ] lmap list>array
] unit-test
{ { 3 4 5 6 } } [ { { 3 4 5 6 } } [
T{ cons f 1 T{ cons f 1
T{ cons f 2 T{ cons f 2

6
basis/lists/lists.factor
View File

@ -58,9 +58,6 @@ PRIVATE>
: leach ( ... list quot: ( ... elt -- ... ) -- ... ) : leach ( ... list quot: ( ... elt -- ... ) -- ... )
over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive
: lmap ( ... list quot: ( ... elt -- ... newelt ) -- ... result )
over nil? [ drop ] [ (leach) lmap cons ] if ; inline recursive
: foldl ( ... list identity quot: ( ... prev elt -- ... next ) -- ... result ) : foldl ( ... list identity quot: ( ... prev elt -- ... next ) -- ... result )
swapd leach ; inline swapd leach ; inline
@ -76,6 +73,9 @@ PRIVATE>
: lreverse ( list -- newlist ) : lreverse ( list -- newlist )
nil [ swons ] foldl ; nil [ swons ] foldl ;
: lmap ( ... list quot: ( ... elt -- ... newelt ) -- ... result )
[ nil ] dip [ swapd dip cons ] curry foldl lreverse ; inline
: lappend ( list1 list2 -- newlist ) : lappend ( list1 list2 -- newlist )
[ lreverse ] dip [ swons ] foldl ; [ lreverse ] dip [ swons ] foldl ;