From bb050c9f4c6f9581be9b6407737c5a271082b0c1 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Wed, 4 Jun 2008 01:40:51 -0400
Subject: [PATCH] Adding lmap and traverse to extra/lists

---
 extra/lists/lists-tests.factor | 4 ++++
 extra/lists/lists.factor       | 8 ++++----
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/extra/lists/lists-tests.factor b/extra/lists/lists-tests.factor
index 534c20245b..0abb8befeb 100644
--- a/extra/lists/lists-tests.factor
+++ b/extra/lists/lists-tests.factor
@@ -41,6 +41,10 @@ IN: lists.tests
   { 1 2 { 3 4 { 5 } } } seq>cons cons>seq  
 ] unit-test
     
+{ T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [
+    { 1 2 3 4 } seq>cons [ 1+ ] lmap
+] unit-test
+    
 ! { { 3 4 { 5 6 { 7 } } } } [
 !   { 1 2 { 3 4 { 5 } } } seq>cons [ 2 + ] traverse cons>seq
 ! ] unit-test
\ No newline at end of file
diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor
index 388bfb5bd7..b0fd41fe75 100644
--- a/extra/lists/lists.factor
+++ b/extra/lists/lists.factor
@@ -59,9 +59,6 @@ M: object nil? drop f ;
 : lreduce ( list identity quot -- result )
     swapd leach ; inline
     
-! : lmap ( cons quot -- newcons )    
-    
-    
 : (lmap>array) ( acc cons quot -- newcons )
     over nil? [ 2drop ]
     [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; inline
@@ -72,6 +69,9 @@ M: object nil? drop f ;
 : lmap-as ( cons quot exemplar -- seq )
     [ lmap>array ] dip like ;
     
+: lmap ( list quot -- newlist )    
+    lmap>array <reversed> nil [ swap cons ] reduce ;
+    
 : same? ( obj1 obj2 -- ? ) 
     [ class ] bi@ = ;
     
@@ -82,6 +82,6 @@ M: object nil? drop f ;
     [ dup cons? [ cons>seq ] when ] lmap>array ;
     
 : traverse ( list quot -- newlist )
-    [ over list? [ traverse ] [ call ] if ] curry  ;
+    [ over list? [ traverse ] [ call ] if ] curry lmap ;
     
 INSTANCE: cons list
\ No newline at end of file