diff --git a/extra/lisp/parser/parser-tests.factor b/extra/lisp/parser/parser-tests.factor index 41254db5b3..4aa8154690 100644 --- a/extra/lisp/parser/parser-tests.factor +++ b/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 diff --git a/extra/lists/lists-docs.factor b/extra/lists/lists-docs.factor index 4fae52f5b4..51b068d979 100644 --- a/extra/lists/lists-docs.factor +++ b/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 -- )" } } diff --git a/extra/lists/lists-tests.factor b/extra/lists/lists-tests.factor index 16bc65ebb3..534c20245b 100644 --- a/extra/lists/lists-tests.factor +++ b/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 \ No newline at end of file +] 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 f9b7b89e5b..388bfb5bd7 100644 --- a/extra/lists/lists.factor +++ b/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 -- ? ) [ ] 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 \ No newline at end of file