Fixing implementation of nil

extra/lisp/parser/parser-tests.factor

@@ -40,8 +40,7 @@ IN: lisp.parser.tests
     "+" "atom" \ lisp-expr rule parse parse-result-ast
 ] unit-test
 
-{ T{ cons f f f }
-} [
+{ +nil+ } [
     "()" lisp-expr parse-result-ast
 ] unit-test
 
@@ -53,7 +52,7 @@ IN: lisp.parser.tests
         cons
         f
         1
-        T{ cons f 2 T{ cons f "aoeu" T{ cons f f f } } }
+        T{ cons f 2 T{ cons f "aoeu" +nil+ } }
     } } } [
     "(foo 1 2 \"aoeu\")" lisp-expr parse-result-ast
 ] unit-test
@@ -61,8 +60,8 @@ IN: lisp.parser.tests
 { T{ cons f
        1
        T{ cons f
-           T{ cons f 3 T{ cons f 4 T{ cons f f f } } }
-           T{ cons f 2 T{ cons f f } } }
+           T{ cons f 3 T{ cons f 4 +nil+ } }
+           T{ cons f 2 +nil+ } }
    }
 } [
     "(1 (3 4) 2)" lisp-expr parse-result-ast

extra/lists/lists-docs.factor

@@ -58,7 +58,7 @@ HELP: uncons
 { $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
 { $description "Put the head and tail of the list on the stack." } ;
 
-{ leach lreduce lmap } related-words
+{ leach lreduce lmap>array } related-words
 
 HELP: leach
 { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- )" } }

extra/lists/lists-tests.factor

@@ -9,7 +9,7 @@ IN: lists.tests
         T{ cons f 2 
             T{ cons f 3
                 T{ cons f 4
-                T{ cons f f f } } } } } [ 2 + ] lmap
+                +nil+ } } } } [ 2 + ] lmap>array
 ] unit-test
 
 { 10 } [
@@ -17,7 +17,7 @@ IN: lists.tests
         T{ cons f 2 
             T{ cons f 3
                 T{ cons f 4
-                T{ cons f f f } } } } } 0 [ + ] lreduce
+                +nil+ } } } } 0 [ + ] lreduce
 ] unit-test
     
 { T{ cons f
@@ -30,13 +30,17 @@ IN: lists.tests
                   T{ cons f
                       4
                       T{ cons f
-                          T{ cons f 5 T{ cons f f f } }
-                          T{ cons f f f } } } }
-          T{ cons f f f } } } }
+                          T{ cons f 5 +nil+ }
+                          +nil+ } } }
+          +nil+ } } }
 } [
     { 1 2 { 3 4 { 5 } } } seq>cons
 ] unit-test
     
 { { 1 2 { 3 4 { 5 } } } } [
   { 1 2 { 3 4 { 5 } } } seq>cons cons>seq  
-] unit-test
+] unit-test
+    
+! { { 3 4 { 5 6 { 7 } } } } [
+!   { 1 2 { 3 4 { 5 } } } seq>cons [ 2 + ] traverse cons>seq
+! ] unit-test

extra/lists/lists.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Chris Double & James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences accessors math arrays vectors classes ;
+USING: kernel sequences accessors math arrays vectors classes words ;
 
 IN: lists
 
@@ -8,8 +8,8 @@ IN: lists
 MIXIN: list
 GENERIC: car   ( cons -- car )
 GENERIC: cdr   ( cons -- cdr )
-GENERIC: nil?  ( cons -- ? )
-
+GENERIC: nil?   ( cons -- ?   )
+    
 TUPLE: cons car cdr ;
 
 C: cons cons
@@ -19,15 +19,15 @@ M: cons car ( cons -- car )
 
 M: cons cdr ( cons -- cdr )
     cdr>> ;
+    
+SYMBOL: +nil+
+M: word nil? +nil+ eq? ;
+M: object nil? drop f ;
 
-: nil ( -- cons )
-  T{ cons f f f } ;
+: nil ( -- +nil+ ) +nil+ ; 
     
 : uncons ( cons -- cdr car )
     [ cdr ] [ car ] bi ;
-
-M: cons nil? ( cons -- ? )
-    uncons and not ;
     
 : 1list ( obj -- cons )
     nil cons ;
@@ -59,15 +59,18 @@ M: cons nil? ( cons -- ? )
 : lreduce ( list identity quot -- result )
     swapd leach ; inline
     
-: (lmap) ( acc cons quot -- seq )    
-    over nil? [ 2drop ]
-    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap) ] if ; inline
+! : lmap ( cons quot -- newcons )    
     
-: lmap ( cons quot -- seq )
-    { } -rot (lmap) ; inline
+    
+: (lmap>array) ( acc cons quot -- newcons )
+    over nil? [ 2drop ]
+    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; inline
+    
+: lmap>array ( cons quot -- newcons )
+    { } -rot (lmap>array) ; inline
     
 : lmap-as ( cons quot exemplar -- seq )
-    [ lmap ] dip like ;
+    [ lmap>array ] dip like ;
     
 : same? ( obj1 obj2 -- ? ) 
     [ class ] bi@ = ;
@@ -76,6 +79,9 @@ M: cons nil? ( cons -- ? )
     [ <reversed> ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ;
     
 : cons>seq ( cons -- array )    
-    [ dup cons? [ cons>seq ] when ] lmap ;
+    [ dup cons? [ cons>seq ] when ] lmap>array ;
+    
+: traverse ( list quot -- newlist )
+    [ over list? [ traverse ] [ call ] if ] curry  ;
     
 INSTANCE: cons list