From 0856bb5711c643618014297a964e77ae4a29b7d3 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 7 Nov 2011 10:37:13 -0800
Subject: [PATCH] lists: make lmap behave row-polymorphically Fix contributed
 by @bremac. Fixes #355.

---
 basis/lists/lists-tests.factor |  4 ++++
 basis/lists/lists.factor       | 10 +++++-----
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/basis/lists/lists-tests.factor b/basis/lists/lists-tests.factor
index d2f969cddc..a39cc17490 100644
--- a/basis/lists/lists-tests.factor
+++ b/basis/lists/lists-tests.factor
@@ -7,6 +7,10 @@ IN: lists.tests
     { 1 2 3 4 5 } sequence>list [ 2 + ] lmap list>array
 ] 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 } } [
     T{ cons f 1       
         T{ cons f 2 
diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor
index 87f69d16e1..91b671bd61 100644
--- a/basis/lists/lists.factor
+++ b/basis/lists/lists.factor
@@ -58,9 +58,6 @@ PRIVATE>
 : leach ( ... list quot: ( ... elt -- ... ) -- ... )
     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 )
     swapd leach ; inline
 
@@ -73,10 +70,13 @@ PRIVATE>
 : llength ( list -- n )
     0 [ drop 1 + ] foldl ;
 
-: lreverse ( list -- newlist )    
+: lreverse ( list -- newlist )
     nil [ swons ] foldl ;
 
-: lappend ( list1 list2 -- newlist )    
+: lmap ( ... list quot: ( ... elt -- ... newelt ) -- ... result )
+    [ nil ] dip [ swapd dip cons ] curry foldl lreverse ; inline
+
+: lappend ( list1 list2 -- newlist )
     [ lreverse ] dip [ swons ] foldl ;
 
 : lcut ( list index -- before after )