; a LISP evaluator
; 3 Sept 03
; this one maintians a persistent environment, so we can define functions etc
; Uses dynamic binding, as this is easier to implement

; A closure is
; ( (bound variables) . body ) . (environment-names . environment-values) )

(new (closure n v)
	(cons
		(cons args body)
		(cons (cons 'f n) (cons ? v))
	)
) 

(new namelist Ø)
(new valuelist Ø)

(new eval Ø) ; forward reference 

(new (create-function name args body n v)
	(seq
		(set namelist (cons name namelist))
		(set valuelist (cons (eval (list 'λ args body) n v) valuelist))
		(list '"defun " name)
	)
)

(new (trace arg) ; a handy trace routine
	(seq 
		(new (last arg)
			(if 
				(atom arg) arg
				(= Ø (cdr arg)) (car arg)
				(last (cdr arg))
			)
		)
		(apply print (cons 'Trace: (from arg)))
		(last (from arg))
	)
)
; (new (f) 3) (new n 4) (trace '"(f" n '")=" (f n))

(new (locate x l m)
	(if
		(= x (car l))
			(car m)
		(locate x (cdr l) (cdr m))
	)
)

(new (lookup x n v)
	(if
		(= n Ø) Ø
		(member x (car n)) (locate x (car n) (car v))
		(lookup x (cdr n) (cdr v))
	)
)

(new (caaar  e) (car  (caar e)))
(new (caadr  e) (car  (cadr e)))
(new (caddr  e) (car  (cddr e)))
(new (cadddr e) (cadr (cddr e)))
(new (cdaar  e) (cdr  (caar e)))
(new (cdadr  e) (cdr  (cadr e)))
(new (cdddr  e) (cdr  (cddr e)))
(new (cddddr e) (cddr (cddr e)))

(new (builtin e) 
	(lookup (car e) 
		         '((+ - * / % = ≤ ≠ < > ≥ cons apply list print atom number car cdr language))
		(list (list + - * / % = ≤ ≠ < > ≥ cons apply list print atom number car cdr language))
	)
)

; ( (bound variables) . body ) . (environment-names . environment-values) )
(new (eval-list sexpr n v)
;	(eval (cdaar sexpr) (cons (caaar sexpr) (cadar sexpr)) (cons (cdr sexpr) (cddar sexpr)))
	(eval (cdaar sexpr) (cons (caaar sexpr) n) (cons (cdr sexpr) v))
)
 ⇒ <closure> 
(new (eval-if test true-part else-part n v)
	(if 
		(eval test n v) (eval true-part n v)
		(cdr else-part) (eval-if (car else-part) (cadr else-part) (cddr else-part) n v)
		(eval (car else-part) n v)
	)
)

(new (eval-seq e n v)
	(if 
		(= e Ø) Ø
		(= (cdr e) Ø) (eval (car e) n v)
		(seq
			(eval (car e) n v)
			(eval-seq (cdr e) n v)
		)
	)
)

(set (eval e n v)
	(if
		(= e Ø) Ø
		(number e) e
		(atom e) (lookup e n v)
		(= (car e) 'defun)
			(create-function (caadr e) (cdadr e) (caddr e) n v)
		(= (car e) 'quote) (cadr e)
		(= (car e) 'if)
			(eval-if (cadr e) (caddr e) (cdddr e) n v)
		(= (car e) 'λ)
			(cons (cons (cadr e) (caddr e)) (cons n v))
		(= (car e) 'eval)
			(eval (eval (cadr e) n v) n v)
		(= (car e) 'seq)
			(eval-seq (cdr e) n v)
		(= (car e) 'set)
			(eval-set '?) ; not yet implemented
		(builtin e)
			(apply (builtin e) (map (λ (t) (eval t n v)) (cdr e)))
		(eval-list (map (λ (t) (eval t n v)) e) n v)
	)
)
 ⇒ [([eval] (λ (n) (if (= n 0) 1 (* n (f (- n 1))))) nil nil)]
(if (= n 0) 1 (* n (f (- n 1))))
(n)
[([lookup] f ((f)) (([closure])))]
nil
([p])
3
<closure>
[([eval] (f 3) ((f)) ((<closure>)))]
nil
nil
nil
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure>
<closure> 
 (eval '(* 2 3 4) nil nil)
 ⇒ (Trace: eval 4 = 4)
(Trace: eval 3 = 3)
(Trace: eval 2 = 2)
(Trace: eval (* 2 3 4) = 24)
24 
(eval '(eval '(* 2 3 4 5)) nil nil)
 ⇒ (Trace: eval '(* 2 3 4 5) = (* 2 3 4 5))
(Trace: eval 5 = 5)
(Trace: eval 4 = 4)
(Trace: eval 3 = 3)
(Trace: eval 2 = 2)
(Trace: eval (* 2 3 4 5) = 120)
(Trace: eval (eval '(* 2 3 4 5)) = 120)
120 

(new (nth n s))

(new (new-eval e)
	(if 
		(atom e)
			(eval e)
		(number (car e))
			(eval (nth (car e) (cdr e)))
		(eval e)
	)
)

(new (newer-eval e)
	(if 
		(atom e)
			(eval e)
		(number (car e))
			((car e) (cdr e)))
		(eval e)
	)
)

(eval '(if 1 2 3) nil nil )
 ⇒ (Trace: eval 1 = 1)
(Trace: eval 2 = 2)
(Trace: eval (if 1 2 3) = 2)
2 (eval '(if nil 2 1 'b 3) nil nil)
(eval '(* 2 3 4) nil nil) 
(eval '((λ (a) a) 99) nil nil) ⇒ (Trace: eval 99 = 99)
(Trace: eval (λ (a) a) = (((a) . a) nil))
(Trace: eval a = 99)
(Trace: eval ((λ (a) a) 99) = 99)
99  (language (λ (sexp) (eval sexp (list namelist) (list valuelist)))) ⇒ <closure> 

(defun (fib n)
	(if (≤ n 1) 1
		(+ (fib (- n 1)) (fib (- n 2)))
	)
) ⇒ (Trace: eval (λ (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))) = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval (defun (fib n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))) = (defun  fib))
(defun  fib) 
(fib 4) ⇒ (Trace: eval 4 = 4)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 4)
(Trace: eval (<= n 1) = nil)
(Trace: eval 2 = 2)
(Trace: eval n = 4)
(Trace: eval (- n 2) = 2)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (<= n 1) = nil)
(Trace: eval 2 = 2)
(Trace: eval n = 2)
(Trace: eval (- n 2) = 0)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 0)
(Trace: eval (<= n 1) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 1)
(Trace: eval (fib (- n 2)) = 1)
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (- n 1) = 1)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 1)
(Trace: eval (<= n 1) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 1)
(Trace: eval (fib (- n 1)) = 1)
(Trace: eval (+ (fib (- n 1)) (fib (- n 2))) = 2)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 2)
(Trace: eval (fib (- n 2)) = 2)
(Trace: eval 1 = 1)
(Trace: eval n = 4)
(Trace: eval (- n 1) = 3)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 3)
(Trace: eval (<= n 1) = nil)
(Trace: eval 2 = 2)
(Trace: eval n = 3)
(Trace: eval (- n 2) = 1)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 1)
(Trace: eval (<= n 1) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 1)
(Trace: eval (fib (- n 2)) = 1)
(Trace: eval 1 = 1)
(Trace: eval n = 3)
(Trace: eval (- n 1) = 2)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (<= n 1) = nil)
(Trace: eval 2 = 2)
(Trace: eval n = 2)
(Trace: eval (- n 2) = 0)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 0)
(Trace: eval (<= n 1) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 1)
(Trace: eval (fib (- n 2)) = 1)
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (- n 1) = 1)
(Trace: eval fib = (((n) if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) ((g g g f)) ((((n) . n) nil) (((n) . n) [unbound parameter] . [unbound parameter]) ((nil quote g) nil) (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))))
(Trace: eval 1 = 1)
(Trace: eval n = 1)
(Trace: eval (<= n 1) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 1)
(Trace: eval (fib (- n 1)) = 1)
(Trace: eval (+ (fib (- n 1)) (fib (- n 2))) = 2)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 2)
(Trace: eval (fib (- n 1)) = 2)
(Trace: eval (+ (fib (- n 1)) (fib (- n 2))) = 3)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 3)
(Trace: eval (fib (- n 1)) = 3)
(Trace: eval (+ (fib (- n 1)) (fib (- n 2))) = 5)
(Trace: eval (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))) = 5)
(Trace: eval (fib 4) = 5)
5 

(eval '((λ (a) (+ a a)) 2) nil nil) ⇒ (Trace: eval 2 = 2)
(Trace: eval (λ (a) (+ a a)) = (((a) + a a) nil))
(Trace: eval a = 2)
(Trace: eval a = 2)
(Trace: eval (+ a a) = 4)
(Trace: eval ((λ (a) (+ a a)) 2) = 4)
4 

(eval '(cdr '(+ 2 3 4)) nil nil)

(new l (eval '(λ (a) (+ a a)) nil nil))
 
(eval '(f 2312) '((f))(set valuelist nil) (set namelist nil)) ⇒ (Trace: eval 2312 = 2312)
(Trace: eval f = [(car [(car nil)])])
(Trace: eval [(cdr [(car [(car [(car nil)])])])] = [(if [(= [(cdr [(car [(car [(car nil)])])])] nil)] nil)])
(Trace: eval (f 2312) = [(if [(= [(cdr [(car [(car [(car nil)])])])] nil)] nil)])
[(if [(= [(cdr [(car [(car [(car nil)])])])] nil)] nil)] 
;(eval '(λ (a) (+ a a)) 'NAMELIST 'VALUELIST)
 (eval '(defun (t a) (* a a)) nil nil) ⇒ (Trace: eval (λ (a) (* a a)) = (((a) * a a) nil))
(Trace: eval (defun (t a) (* a a)) = (defun  t))
(defun  t)  namelist ⇒ (t t t) 
valuelist ⇒ ((((a) * a a) nil) (((a) * a a) nil) (((a) * a a) nil)) 
(eval '(t 11) (list namelist) (list valuelist)) ⇒ (Trace: eval 11 = 11)
(Trace: eval t = (((a) * a a) nil))
(Trace: eval a = 11)
(Trace: eval a = 11)
(Trace: eval (* a a) = 121)
(Trace: eval (t 11) = 121)
121 namelist ⇒ (f) 
(eval '(defun (f n) (if (= n 0) 1 (* n (f (- n 1))))) (list namelist) (list valuelist))
 ⇒ (Trace: eval (λ (n) (if (= n 0) 1 (* n (f (- n 1))))) = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval (defun (f n) (if (= n 0) 1 (* n (f (- n 1))))) = (defun  f))
(defun  f) (eval '(f 4) (list namelist) (list valuelist)) ⇒ (Trace: eval 4 = 4)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 4)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 4)
(Trace: eval (- n 1) = 3)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 3)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 3)
(Trace: eval (- n 1) = 2)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 2)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (- n 1) = 1)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 1)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 1)
(Trace: eval (- n 1) = 0)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 0)
(Trace: eval (= n 0) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 1)
(Trace: eval (f (- n 1)) = 1)
(Trace: eval n = 1)
(Trace: eval (* n (f (- n 1))) = 1)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 1)
(Trace: eval (f (- n 1)) = 1)
(Trace: eval n = 2)
(Trace: eval (* n (f (- n 1))) = 2)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 2)
(Trace: eval (f (- n 1)) = 2)
(Trace: eval n = 3)
(Trace: eval (* n (f (- n 1))) = 6)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 6)
(Trace: eval (f (- n 1)) = 6)
(Trace: eval n = 4)
(Trace: eval (* n (f (- n 1))) = 24)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 24)
(Trace: eval (f 4) = 24)
24 

(eval '(g (f 3)) (list namelist) (list valuelist)) ⇒ (Trace: eval 25 = 25)
 ⇒ (Trace: eval 3 = 3)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 3)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 3)
(Trace: eval (- n 1) = 2)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 2)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 2)
(Trace: eval (- n 1) = 1)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 1)
(Trace: eval (= n 0) = nil)
(Trace: eval 1 = 1)
(Trace: eval n = 1)
(Trace: eval (- n 1) = 0)
(Trace: eval f = (((n) if (= n 0) 1 (* n (f (- n 1)))) (nil) nil))
(Trace: eval 0 = 0)
(Trace: eval n = 0)
(Trace: eval (= n 0) = true)
(Trace: eval 1 = 1)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 1)
(Trace: eval (f (- n 1)) = 1)
(Trace: eval n = 1)
(Trace: eval (* n (f (- n 1))) = 1)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 1)
(Trace: eval (f (- n 1)) = 1)
(Trace: eval n = 2)
(Trace: eval (* n (f (- n 1))) = 2)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 2)
(Trace: eval (f (- n 1)) = 2)
(Trace: eval n = 3)
(Trace: eval (* n (f (- n 1))) = 6)
(Trace: eval (if (= n 0) 1 (* n (f (- n 1)))) = 6)
(Trace: eval (f 3) = 6)
(Trace: eval g = (((n) . n) nil))
(Trace: eval n = 6)
(Trace: eval (g (f 3)) = 6)
6
[⇒]
[([Trace:] <closure> 25 <closure> 25)] (Trace: eval g = nil)
(Trace: eval [(cdr [(car nil)])] = [(if [(= [(cdr [(car nil)])] nil)] nil)])
(Trace: eval (g 25) = [(if [(= [(cdr [(car nil)])] nil)] nil)])
[(if [(= [(cdr [(car nil)])] nil)] nil)] 
(eval (list (eval (list 'λ '(a) (list '(+ a a))) nil nil) 7) nil nil)
(set namelist '(n))
(set valuelist '(123))  
(lookup 'n (list namelist) (list valuelist)) 
(eval 'n (list namelist) (list valuelist)) 
(eval '(defun (g n) n) nil nil) 
 ⇒ (Trace: eval (λ (n) n) = (((n) . n) nil))
(Trace: eval (defun (g n) n) = (defun  g))
(defun  g) (eval '(g) namelist valuelist)
(list namelist)  
(lookup 'g namelist valuelist) 
(eval '(list n) (list namelist) (list valuelist))

((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 8
)  
(eval '((λ (a b c) 'z) 'xx) nil nil) 
 (eval '((λ (a) 'a)) nil nil) 
 
(eval '((λ (a) (a 213)) (λ (x) x)) nil nil)

(new (y f n) (f f n))
(new (fact f n) (if (= n 0) 1 (* n (y f (- n 1)))))
(y fact 3)

(set namelist nil)
(set valuelist nil)
(eval '(defun (y f n) (f f n)) namelist valuelist)
(eval '(defun (fact f n) (if (= n 0) 1 (* n (f f (- n 1))))) (list namelist) (list valuelist)) ⇒ 
(eval '(y fact 3) (list namelist) (list valuelist))  (lookup 'fact namelist valuelist)

namelist 
(car valuelist)

(eval '(fact 0 0) namelist valuelist)

(eval '((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 3
) nil nil)

(eval '(car (cons 4 (cons 'fred nil))) nil nil) 
(eval '((λ (x) (cons x x)) 3) nil nil)

 (eval '((λ (a) (cons a a)) 'a) nil nil)  

(language (λ (x) (eval x (list namelist) (list valuelist)))
(if 'nil 2 3)  
((λ (a b) (cons ((λ (a) (cons a a)) a) b)) 'x 'y)
(+ 2 3 4)
(cons 34 234)
(+ (+ 3 4) (+ 100 200))
(= (+ 1 1) 2)