;;; NOW WITH LAMBDA!!!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; A meta-circular interpreter for Scheme

;;; function to evaluate a [little] Scheme expression

;;; A [little] Scheme expression is one of:
;;;  - constant (number,bool)   NUMBER #t #f
;;;  - lambda expression        (lambda VARS BODY)
;;;  - variable                 V
;;;  - quoted form              (quote VALUE)
;;;  - if expression            (if TEST THEN-PART ELSE-PART)
;;;  - function calls           (F X1 ... Xn)

;;; Evaluate lScheme expression e in environment env, represented
;;; as alist of variable names (symbols) to lScheme values.

(define my-eval
  (lambda (e env)
    (cond ((number? e) e)
	  ((equal? e #t) #t)
	  ((equal? e #f) #f)
	  ((symbol? e) (lookup-variable e env))
	  ((pair? e)
	   (let ((s (car e)))
	     (cond ((equal? s 'lambda)
		    ;; represent closure (result of (lambda VARS BODY) in env ENV)
		    ;; as list (%closure VARS BODY ENV)
		    (list '%closure (cadr e) (caddr e) env))
		   ((equal? s 'if)
		    (my-eval (if (my-eval (cadr e) env)
				 (caddr e)
				 (cadddr e))
			     env))
		   ((equal? s 'quote) (cadr e))
		   ((macro-keyword? s)
		    (my-eval (expand-macro e) env))
		   (else
		    ;; regular function call
		    (let ((vs (map (lambda (e) (my-eval e env)) e)))
		      (my-apply (car vs) (cdr vs))))))))))

(define my-apply
  (lambda (f vals)
    (cond ((procedure? f) (apply f vals))
	  ((equal? (car f) '%closure)
	   (let ((vars (cadr f))
		 (body (caddr f))
		 (env (cadddr f)))
	     (my-eval body
		      (append (map list vars vals)
			      env)))))))

;;; look up variable s in environment env, or if not found, in global environment.
(define lookup-variable
  (lambda (s env)
    (cond ((assoc s env) => cadr)
	  ((equal? s '+) (lambda (x y) (+ x y)))
	  ((equal? s 'car) car)
	  ((equal? s 'cons) cons)
	  (else 'unbound-variable))))

(define macro-keyword?
  (lambda (s)
    (assoc s macro-alist)))

(define expand-macro
  (lambda (e)
      (cond ((assoc (car e) macro-alist)
	     => (lambda (c) ((cadr c) e)))
	    (else (error 'internal-error-expand-nonmacro)))))

;;; e has shape: (let ((VAR VEXPR) ...) BODY)
;;; return ((lambda VARs BODY) VEXPRs...)

(define expand-let
  (lambda (e)
    (let ((clauses (cadr e))
	  (body (caddr e)))
      (let ((vars (map car clauses))
	    (vexprs (map cadr clauses)))
	(cons (list 'lambda vars body)
	      vexprs)))))

(define macro-alist
  (list (list 'let expand-let)
	;;(list 'or expand-or)
	;;(list 'and expand-and)
	;;(list 'cond expand-cond)
	))