Fixing implementation of nil
parent
8a7dfd76da
commit
ed18f7d37b
|
@ -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
|
||||
|
|
|
@ -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 -- )" } }
|
||||
|
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue