; a LISP evaluator, based on Peter Henderson

; utilities
(new (caddr e) (car (cddr e)))
(new (cadddr e) (cadr (cddr e)))

; forward definitions
(new eval Ø)  
(new lisp Ø)

; manage the environment
(new (locate x l m)
	(if
		(= l Ø) (list 'Unbound x)
		(= x (car l)) (car m)
		(locate x (cdr l) (cdr m))
	)
)

(new (lookup x n v)
	(if (atom n) (list 'Unbound x)
		(member x (car n)) (locate x (car n) (car v))
		(lookup x (cdr n) (cdr v))
	)
)
 
(new (evlis l n v)
	(if
		(= Ø l) Ø
		(cons (eval (car l) n v) (evlis (cdr l) n v))
	)
)

(new (findop e opnames opfcns)
	(if 
		(= Ø opnames) Ø
		(= e (car opnames)) (car opfcns)
		(findop e (cdr opnames) (cdr opfcns))
	)
)

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

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

(set (eval e n v)
	(if
		(= e Ø) Ø
		(number e) e
		(atom e) (lookup e n v)
		(= (car e) 'quote) (cadr e)
		(operator e) (apply (operator e) (map (λ (t) (eval t n v)) (cdr e)))
		(= (car e) 'language) (language (λ (s) (lisp (list (cadr e) s))))
		(= (car e) 'if)
			(eval (if (eval (cadr e) n v) (caddr e) (cadddr e)) n v)
		(or (= (car e) 'lambda) (= (car e) 'λ))
			(cons (cons (cadr e) (caddr e)) (cons n v))
		(let 
			(eval (cdar c) (cons (caar c) (cadr c)) (cons (evlis (cdr e) n v) (cddr c)))
			(c . (eval (car e) n v))
		)
	)
)

; define a new LISP with built in functions

(new builtins-values (map (λ (f) (eval (list 'λ '(a b) (list f 'a 'b)) Ø Ø)) builtins))

(set (lisp expr) (eval expr (list builtins) (list builtins-values)))

;----------------------------------------------

(lisp '(if 't 1 ''2)) 
(eval '((λ (x) x) 2) '((x y)) '((3 4)))
(eval '((λ (x) y) 2) '((x y)) '((3 4)))
(eval '(λ (x y) (* x y)) '((x y)) '((3 4))) 

(eval '(* 3 4) Ø Ø) 

(new multiply (eval '(λ (x y) (* x y)) Ø Ø))
(eval '(prod 3 4) '((prod)) (list (list multiply))) 

(eval '(cons 'hello 'world) Ø Ø)  
(lisp '((λ (a b c) b) 'xx 'yy 'zz))
(lisp '(λ (a) a)) 

(lisp '((λ (a) (a)) (λ (v) 2))) 
((λ (a) (a)) (λ (v) 2))  

(lisp '(car (cons 4 (cons 'fred Ø)))) 

(lisp '(+ 2 3)) 
(lisp '(λ (a b) (+ a b))) 
(eval '(((λ () +)) 2 3) '((+)) (list (list (eval '(λ (a b) (+ a b)) Ø Ø))))
(lisp '(((λ () *)) 2 3)) 
(lisp '(((λ () +)) 2 3)) 

(((λ () +)) 2 3) 

(lisp '((λ (x) (cons x x)) 3))  
(lisp '((λ (a) (cons a a)) 'a))  
 
((λ (a b) (cons ((λ (a) (cons a a)) a) b)) 'x 'y)
(+ 2 3 4)
(cons 34 234)
(+ (+ 3 4)
(+ 100 200))(= (+ 1 1) 2)
(if 'nil 2 3) 

; doing factorials using the paradoxical combinator
((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 8
)  

(lisp '((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 8
))
;----------------; change the LISP
(language lisp)

((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 8
) 
2

x

; this causes an error; we didn't define lisp
(lisp '((λ (f n) (f f n))
 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
 8
))
 
; as you can see:
(lisp)

; ---------------------------------------------
; now make a factorial language in our new LISP

(language 
	(λ (input)
		((λ (f n) (f f n))
		 (λ (f n) (if (= n 0) 1 (* n (f f (- n 1)))))
		 input
		)
	)
)

4

5

7