----------------------------------------------------------------- --- LISP Tests -------------------------------------------------- ----------------------------------------------------------------- ----------------------------------------------------------------- --- Representing and evaluating polynomials as lists --- 3x^2-2x'+5 becomes [[3 2] [-2 1] [5 0]] red run( [defun 'term-factor ['term] [car 'term]] [defun 'term-power ['term] [car [cdr 'term]]] [defun 'make-term ['factor 'power] [list 'factor 'power]] [defun 'evaluate ['poly x] [if [null 'poly] 0 [let [['term [car 'poly]]] ['+ ['* ['term-factor 'term] [expt x ['term-power 'term]]] ['evaluate [cdr 'poly] x]]]]] [print ['evaluate $ [[3 2]] 4]] [print ['evaluate $ [[1 4] [2 1]] 3]] [print ['evaluate $ [[1 8] [-1 0]] 2]] ) . ***> should be Output: "48" : "87" : "255" ----------------------------------------------------------------- --- Calculating the total (i.e., sum) of a list of integers red run( [defun 'total ['num-list] [cond [[endp 'num-list] 0] [t ['+ [car 'num-list] ['total [cdr 'num-list]]]]]] [print ['total $ [1 2 3 4 5 6 7]]] [print ['total $ [11 6]]] ) . ***> should be Output: "28" : "17" ----------------------------------------------------------------- --- Counting the number of atoms in a form red run( [defun 'count-atoms [l] [cond [[null l] 0] [[atom l] 1] [t ['+ ['count-atoms [car l]] ['count-atoms [cdr l]]]]]] [print ['count-atoms $ [a b c d]]] [print ['count-atoms $ [a [b e [f g] h] c d]]] [print ['count-atoms $ a]] ) . ***> should be Output: "4" : "8" : "1" ----------------------------------------------------------------- --- Calculating the factorial of an integer red run( [defun 'fact [n] [if ['= n 0] 1 ['* ['fact ['- n 1]] n]]] [print ['fact 0]] [print ['fact 1]] [print ['fact 2]] [print ['fact 3]] [print ['fact 4]] [print ['fact 5]] ) . ***> should be Output: "1" : "1" : "2" : "6" : "24" : "120" ----------------------------------------------------------------- red run( [defun f [x] [quote [6 7 8]]] [setf a [f 1]] [print a] [setf [car a] 0] [print a] [setf b [f 1]] [print b] ) . ***> should be Output: "[6 7 8]" : "[0 7 8]" : "[6 7 8]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [setf b [quote [4 5 6]]] [setf c [append a b]] [setf [car a] 111] [setf [car b] 444] [print a] [print b] [print c] ) . ***> should be Output: "[111 2 3]" : "[444 5 6]" : "[1 2 3 444 5 6]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3 4]]] [setf b [quote [5 6 7 8]]] [print a] [print b] [print [car [cdr a]]] [setf [cdr a] [cdr b]] [print a] ) . ***> should be Output: [1 2 3 4] : [5 6 7 8] : 2 : [1 6 7 8] ----------------------------------------------------------------- red run( [setf a [quote [0 1 2 4]]] [print a] [setf [car a] 9] [print a] ) . ***> should be Output: [0 1 2 4] : [9 1 2 4] ----------------------------------------------------------------- red run( [setf a [quote [0 1 2 4]]] [print a] [print [cdr a]] [setf [cdr a] [quote [a b]]] [print a] ) . ***> should be Output: [0 1 2 4] : [1 2 4] : [0 a b] ----------------------------------------------------------------- red run( [print [list $ a 4 $ b $ [c d] 6]] [print [list]] ) . ----------------------------------------------------------------- red run( [defun f [x] [cond [['= x 1] {"one"}] [['= x 2] {"two"}] [t {"neither"}]]] [print [f 1]] [print [f 2]] [print [f 3]] ) . ***> should be Output: "{one}" : "{two}" : "{neither}" ----------------------------------------------------------------- red run( [setf f [lambda [x y &rest z] [print x] [print y] [print z]]] [funcall f 3 5] [funcall f 3 5 7 9 11] ) . ***> should be Output: "3" : "5" : "nil" : "3" : "5" : "[7 9 11]" ----------------------------------------------------------------- red run( [defun 'f2 [x y &rest z] [print x] [print y] [print z]] ['f2 4 6] ['f2 4 6 8] ) . ***> should be Output: "4" : "6" : "nil" : "4" : "6" : "[8]" ----------------------------------------------------------------- red run( [setf a $ [9 10]] [print [list]] [setf x [list a $ [b f j] $ c nil]] [print x] ) . ***> should be Output: "nil" : "[[9 10] [b f j] c nil]" ----------------------------------------------------------------- red run( [print [or]] [print [or $ e $ d]] [print [or nil 1 2 3]] [print [or t]] [print [or nil]] [print [or [not nil]]] [print [or [not 6]]] ) . ***> should be Output: "nil" : "e" : "1" : "t" : "nil" : "t" : "nil" ----------------------------------------------------------------- red run( [print [and]] [print [and $ e $ d]] [print [and 1 2 nil 4]] [print [and 1 2 3 4]] [print [and t]] [print [and nil]] [print [and [not nil]]] ) . ***> should be Output: "t" : "d" : "nil" : "4" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [setf 'xxx $ [88 99]] [defun 'xxx [] [append $ [66 77] 'xxx]] [print 'xxx] [print ['xxx]] [print #$ 'xxx] [print #$ car] ) . ***> should be Output: "[88 99]" : "[66 77 88 99]" : "" : "" ----------------------------------------------------------------- red run( ['defmacro 'my-cadr [x] [list $ car [list $ cdr x]]] [print ['macroexpand [quote ['my-cadr f]]]] [print ['my-cadr [quote [a b c]]]] ) . ----------------------------------------------------------------- red run ([print [funcall [function [lambda [x] ['+ x 9]]] 2 ]]) . ***> should be Output: "11" ----------------------------------------------------------------- red run ([setf f [lambda [x] ['+ x 9]]] [print f] [print [funcall f 37]]) . ***> should be Output: " : "46" ----------------------------------------------------------------- red run ( [print [funcall [quote print] 8]] [print [funcall $ print 8]] ) . ***> should be Output: "8" : "nil" :"8" : "nil" ----------------------------------------------------------------- red run ( [print [funcall [function print] 8]] [print [funcall #$ print 8]] [print [funcall #' print 8]] ) . ***> should be Output: "8" : "nil" :"8" : "nil" :"8" : "nil" ----------------------------------------------------------------- red run( [defun 'add [w z] ['+ w z]] [print [funcall [function 'add] 2 4]] [print [funcall [function '*] 5 7]] ) . ***> should be Output: "6" : "35" ----------------------------------------------------------------- red run ( [defun 'xxx [] 4] [print [function 'xxx]] [print [function car]] [print [function atom]] ) . ***> should be Output: "" : "" : "" ----------------------------------------------------------------- red run( [print [atom 9]] [print [atom {"string"}]] [setf a 44] [print [atom a]] [print [atom [quote [3 4 5]]]] ) . ***> should be Output: "t" : "t" : "t" : "nil" ----------------------------------------------------------------- red run( [print [progn 5 6 7 8 9]] [print [prog1 5 6 7 8 9]] [print [prog2 5 6 7 8 9]] [print [progn 20 30]] [print [prog1 20 30]] [print [prog2 20 30]] [print [progn 77]] [print [prog1 77]] [print [progn]] ) . ***> should be Output: "9" : "5" : "6" : "30" : "20" : "30" : "77" : "77" : "nil" ----------------------------------------------------------------- red run( [setf a 999] [print a] [let [[a 1][b 2][c a][d 4]] [print a] [print b] [print c] [print d] [let* [[a 55][b b][c a][d 88]] [print a] [print b] [print c] [print d]] [print a] [print b] [print c] [print d]] [print a] ) . ***> should be Output: "999" : "1" : "2" : "999" : "4" : "55" : "2" : "55" : "88" : "1" : "2" : "999" : "4" : "999" ----------------------------------------------------------------- red run( [setf a 999] [print a] [let [] [print a]] [print a] [let* [] [print a]] [print a] ) . ***> should be Output: "999" : "999" : "999" : "999" ----------------------------------------------------------------- red run( [setf a 999] [print a] [let [[a 4] [b ['+ a 22]]] [print a] [print b] [setf a ['+ a 2]] [print a]] [print a] ) . ***> should be Output: "999" : "4" : "1021" : "6" : "999" ----------------------------------------------------------------- red run( [setf a 999] [print a] [let* [[a 4] [b ['+ a 22]]] [print a] [print b] [setf a ['+ a 2]] [print a]] [print a] ) . ***> should be Output: "999" : "4" : "26" : "6" : "999" ----------------------------------------------------------------- red run( [setf a 0] [setf b 0] [[lambda [c] [ setf a 10] [setf b 12]] 2] [print a ] [print b ] ) . ***> should be Output: "10" : "12" ----------------------------------------------------------------- red run( [setf a 0] [setf b 0] [ [lambda [] [ setf a 10] [setf b 12]] ] [print a ] [print b ] ) . ***> should be Output: "10" : "12" ----------------------------------------------------------------- red run( [defvar a 20] [print [[lambda [a] [setf a['+ a 100]] [setf a ['- a 7]] [setf a ['+ a 1]]] a]] [print a]) . ***> should be Output: "114" : "20" ----------------------------------------------------------------- red run([print [[lambda [a] ['+ a 10]] 20]]) . ***> should be Output: 30 ----------------------------------------------------------------- red run([print [eval [[lambda [a] ['+ a 10]] 21]]]) . ***> should be Output: 31 ----------------------------------------------------------------- red run( [defun f [a] ['+ a 10]] [print [f 2]] [print [f 4]] [setf f [f 1]] [print f] ) . ***> f has both a value and a function value... separate namespaces. ***> should be Output: "12" : "14" : "11" ----------------------------------------------------------------- red run( [print [if [] [quote 'true] [quote 'false]]] ) . ***> should be Output: "'false" ----------------------------------------------------------------- red run( [print [if 1 [quote 'true] [quote 'false]]] ) . ***> should be Output: "'true" ----------------------------------------------------------------- red run( [print [if {"condition"} [quote 'true] [quote 'false]]] ) . ***> should be Output: "'true" ----------------------------------------------------------------- red run( [print [if 111 [quote 'true]]] ) . ***> should be Output: "'true" ----------------------------------------------------------------- red run( [print [if nil [quote 'true]]] ) . ***> should be Output: "nil" ----------------------------------------------------------------- red run( [print [not nil]] [print [not t]] [print [not 6]] [print [not [quote [a 4 h]]]] ) . ***> should be Output: "t" : "nil" : "nil" : "nil" ----------------------------------------------------------------- red run( [print [listp [quote [1 2 3]]]] [print [listp nil]] [print [listp [quote a]]] [setf x [quote [q w]]] [print [listp x]] ) . ***> should be Output: "t" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [print [consp [quote [1 2 3]]]] [print [consp nil]] [print [consp [quote a]]] [setf x [quote [q w]]] [print [consp x]] ) . ***> should be Output: "t" : "nil" : "nil" : "t" ----------------------------------------------------------------- red run( [print [endp [quote [1 2 3]]]] [print [endp nil]] [print [endp [quote a]]] [setf x [quote nil]] [print [endp x]] ) . ***> should be Output: "nil" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [print [null [quote [1 2 3]]]] [print [null nil]] [print [null [quote a]]] [setf x [quote nil]] [print [null x]] ) . ***> should be Output: "nil" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [print [integerp [quote [1]]]] [print [integerp nil]] [print [integerp [quote a]]] [print [integerp [quote 5]]] [setf x [quote 6]] [print [integerp x]] ) . ***> should be Output: "nil" : "nil" : "nil" : "t" : "t" ----------------------------------------------------------------- red run( [print [numberp [quote [1]]]] [print [numberp nil]] [print [numberp [quote a]]] [print [numberp [quote 5]]] [setf x [quote 6]] [print [numberp x]] ) . ***> should be Output: "nil" : "nil" : "nil" : "t" : "t" ----------------------------------------------------------------- red run( [print [symbolp [quote [1]]]] [print [symbolp nil]] [print [symbolp [quote a]]] [print [symbolp [quote 5]]] [setf x [quote y]] [print [symbolp x]] ) . ***> should be Output: "nil" : "t" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [print [stringp [quote [1]]]] [print [stringp nil]] [print [stringp [quote {"test"}]]] [print [stringp [quote 5]]] [setf x [quote {"test2"}]] [print [stringp x]] ) . ***> should be Output: "nil" : "nil" : "t" : "nil" : "t" ----------------------------------------------------------------- red run( [print [fboundp [quote car]]] [print [fboundp [quote x]]] [print [fboundp nil]] ) . ***> should be Output: "t" : "nil" : "nil" ----------------------------------------------------------------- red run( [print [zerop [quote 0]]] [print [zerop ['- 4 4]]] [print [zerop nil]] ) . ***> should be Output: "t" : "t" : "nil" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [print [append a a]] [print [append nil a]] [print [append a nil]] [print [append nil nil]] ) . ***> should be Output: "[1 2 3 1 2 3]" : "[1 2 3]" : "[1 2 3]" : "nil" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [print [car a]] [print [cdr a]] [print [car []]] [print [cdr []]] [print [car nil]] [print [cdr nil]] ) . ***> should be Output: "1" : "[2 3]" : "nil" : "nil" : "nil" : "nil" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [print [cons [quote x] a]] [print [cons [quote x] [quote y]]] [print [cons nil [quote y]]] ) . ***> should be Output: "[x 1 2 3]" : "[x . y]" : "[nil . y]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [print [cons [quote x] nil]] [print [cons a nil]] [print [cons nil a]] [print [cons nil nil]] ) . ***> should be Output: "[x]" : "[[1 2 3]]" : "[nil 1 2 3]" : "[nil]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [setf b [quote [4 5 6]]] [setf c [append a b]] [print c] ) . ***> should be Output: "[1 2 3 4 5 6]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [setf b [quote 4]] [setf c [append a b]] [print c] ) . ***> should be Output: "[1 2 3 . 4]" ----------------------------------------------------------------- red run( [setf a [quote [1 2 3]]] [setf b [quote 4]] [setf c [append a b]] [print c] [setf c [append c 6]] [print c] ) . ***> should be Output: "[1 2 3 . 4]" : "[1 2 3 . 6]" ----------------------------------------------------------------- red run( [setf a [quote [setf b 7]]] [print a] [eval a] [print b] ) . ***> should be Output: [setf b 7] : 7 ----------------------------------------------------------------- red run( [setf a 3] [setf b 4] [print b] ) . ***> should be NzNat: 4 ----------------------------------------------------------------- red run( [setf a 3] [setf b a] [print b] ) . ***> should be NzNat: 3 ----------------------------------------------------------------- red run( [setf a 4] [setf b a] [setf c b d 6] [print c] [print d] ) . ***> should be Output: 4 : 6 ----------------------------------------------------------------- red run([setf a [quote {"test1"} ]] [print a]) . red run([setf a [quote [[{"test1"}]] ]] [print a]) . red run([setf a [quote [2] ]] [print a]) . red run([setf a [quote [a] ]] [print a]) . red run([setf a [quote [t] ]] [print a]) . red run([setf a [quote [nil] ]] [print a]) . red run([setf a [quote [[2]] ]] [print a]) . red run([setf a [quote [[w]] ]] [print a]) . red run([setf a [quote [[[w]]] ]] [print a]) . red run([setf a [quote [1 e] ]] [print a]) . red run([setf a [quote [[1] e] ]] [print a]) . red run([setf a [quote [4 [w]] ]] [print a]) . red run([setf a [quote [[7][g]] ]] [print a]) . red run([setf a [quote [[7] t 6 [g]] ]] [print a]) . red run([setf a [quote [[7][[g] i]] ]] [print a]) . red run([setf a [quote [[7 8 9][4 5 6]] ]] [print a]) . red run([setf a [quote [1[t r [p]][2[[4[[6]j]]3]]] ]] [print a]) . ----------------------------------------------------------------- red run([setf a $ {"test1"} ] [print a]) . red run([setf a $ [[{"test1"}]] ] [print a]) . red run([setf a $ [2] ] [print a]) . red run([setf a $ [a] ] [print a]) . red run([setf a $ [t] ] [print a]) . red run([setf a $ [nil] ] [print a]) . red run([setf a $ [[2]] ] [print a]) . red run([setf a $ [[w]] ] [print a]) . red run([setf a $ [[[w]]] ] [print a]) . red run([setf a $ [1 e] ] [print a]) . red run([setf a $ [[1] e] ] [print a]) . red run([setf a $ [4 [w]] ] [print a]) . red run([setf a $ [[7][g]] ] [print a]) . red run([setf a $ [[7] t 6 [g]] ] [print a]) . red run([setf a $ [[7][[g] i]] ] [print a]) . red run([setf a $ [[7 8 9][4 5 6]] ] [print a]) . red run([setf a $ [1[t r [p]][2[[4[[6]j]]3]]] ] [print a]) . ----------------------------------------------------------------- red run([setf z 66] [print z]) . ***> should be NzNat: 66 ----------------------------------------------------------------- red run([setf x 66] [setf y [quote x]] [print y]) . ***> should be Name: x ----------------------------------------------------------------- red run([setf x 66] [setf y [quote 44]] [print y]) . ***> should be NzNat: 44 ----------------------------------------------------------------- red run([setf z 66] [print [quote z]]) . ***> should be Name: z ----------------------------------------------------------------- red run( [setf a 4] [print a] [print [quote a]] [print ['+ a 13]] ) . ***> should be Output: 4 : a : 17 ----------------------------------------------------------------- red run([print nil] [print t] ) . ***> should be Output: nil : t ----------------------------------------------------------------- red run([print ['+ 1 2]] ) . ***> should be NzNat: 3 ----------------------------------------------------------------- red run([print ['+ ['+ 1 2] ['+ 3 4]]] ) . ***> should be NzNat: 10 ----------------------------------------------------------------- red run([defvar a 5] [defvar b 8] [print ['+ a b]]) . ***> should be NzNat: 13 ----------------------------------------------------------------- red run([defvar a 5] [defvar a 7] [print a]) . ***> should be NzNat: 5 ----------------------------------------------------------------- red run([setf a 5] [setf a 7] [print a]) . ***> should be NzNat: 7 ----------------------------------------------------------------- red run([print [setf]]) . ***> should be Name: nil ----------------------------------------------------------------- red run([setf a 3] [setf b a] [print b]) . ***> should be NzNat: 3 ----------------------------------------------------------------- red run([defvar a 5] [setf a 7] [print a]) . ***> should be NzNat: 7 ----------------------------------------------------------------- red run([setf a 5 b 7] [print ['+ b a]]) . ***> should be NzNat: 12 ----------------------------------------------------------------- red run([setf a [setf b 7]] [print ['+ a b]]) . ***> should be NzNat: 14 red run( [defun 'create-addr [x y] [list $ '+ x y]] [defun 'create-rec [f x] [if [null x] 0 [funcall f [car x] ['create-rec f [cdr x]]] ]] [print ['create-rec #$ 'create-addr $[1 2 3 4]]] [print [eval ['create-rec #$ 'create-addr $[1 2 3 4]]]] ) .