;;; Implement Scheme evaluator
;;;  symbols, cons pairs (lists)
;;;  CONS, CAR, CDR, QUOTE

;;; ENV = ((var1 val1) (var2 val2) ...)

(define (my-eval expr env)
  (cond ((symbol? expr) (get-val expr env))
	((number? expr) expr)
	((string? expr) expr)
	((null? expr) expr)
	((pair? expr)

	 (cond ((equal? (car expr) 'QUOTE)
		;; The QUOTE special form
		(cadr expr))

	       ((equal? (car expr) 'IF)
		;; The IF construct
		(let ((test (my-eval (cadr expr) env)))
		  (my-eval ((if test caddr cadddr)
			    expr)
			   env)))

	       ((equal? (car expr) 'LAMBDA)
		;; Implement LAMBDA ourselves.
		;; The representation we use here must be
		;; acceptable to MY-APPLY below.
		(list 'closure		;token
		      (cadr expr)	;formal params
		      (caddr expr)	;body
		      env))		;outside env

	       ((equal? (car expr) 'LET)
		;; Macro expand LET expression and evaluate the result
		(my-eval (macro-expand-let expr) env))

	       (else
		(let ((f (my-eval (car expr) env)))
		  (my-apply f (map (lambda (x)
				     (my-eval x env))
				   (cdr expr)))))))

	(else (error "MY-EVAL: don't grok ~A" expr))))



;;; Apply a function to a list of arguments.
;;; We allow both native Scheme functions (like CAR and CONS)
;;; and our own representation of a functions, "CLOSURE list", returned
;;; by LAMBDA expressions.

(define (my-apply f args)
  (cond ((procedure? f) (apply f args))

	((and (pair? f) (equal? (car f) 'closure))
	 (my-eval (caddr f)
		  (append (map list (cadr f) args)
			  (cadddr f))))

	(else (error "MY-APPLY: not a function: ~a" f))))

;;; Look up a variable binding in an environment.
;;; Called by MY-EVAL.

(define (get-val var env)
  (let ((x (assoc var env)))
    (cond (x (cadr x))

	  ;; Enumerate valid global variables here:
	  ((equal? var 'car) car)
	  ((equal? var 'cdr) cdr)
	  ((equal? var 'cons) cons)

	  (else
	   (error "MY-EVAL: Unbound variable ~A" var)))))


;;; (LET ((v1 val1)(v2 val2)...) body)
;;;  ->
;;; ((LAMBDA (v1 v2 ...) body) val1 val2 ...)

(define (macro-expand-let expr)
  (let ((clauses (cadr expr))
	(body (caddr expr)))
    (cons (list 'lambda
		(map car clauses)
		(caddr expr))
	  (map cadr clauses))))


;;; Old clauses from MY-EVAL:

;;;	       ((equal? (car expr) 'LET)
;;;		;; Special code for directly handling LET
;;;		(let ((new-env
;;;		       (append 
;;;			(map (lambda (clause)
;;;			       (let ((var-name (car clause))
;;;				     (val-expr (cadr clause)))
;;;				 (list var-name
;;;				       (my-eval val-expr
;;;						env))))
;;;			     (cadr expr))
;;;			env)))
;;;		  (my-eval (caddr expr) new-env)))

;;;	       ((equal? (car expr) 'LAMBDA)
;;;		;; Implement LAMBDA with LAMBDA
;;;		(lambda (. args)
;;;		   (my-eval (caddr expr)
;;;			    (append (map list (cadr expr) args)
;;;				    env))))


;;; Test cases:

(my-eval 'b '((a aye)(b bee)(c sea)))	;bee

(my-eval '(let ((f (lambda (x y) (cons x (cons y ())))))
	    (let ((x (f a b)))
	      (let ((x (f x x)))
		(let ((x (f x x)))
		  (cons (lambda () (car x)) x)))))
	 '((a aye)(b bee)(c sea)))
 ; ((closure ...) ((aye bee) (aye bee)) ((aye bee) (aye bee)))