;; Simple evaluator for Scheme, introducing environment model.
;; Version 2: Adds DEFINE to Scheme-1.

;; In order to remember definitions, we need something new: *environments*.
;; An environment is a collection of names and associated values.  We'll
;; represent an environment as a table.  (You'll see in the homework that
;; this isn't quite good enough, but it works in almost all situations.)

(DEFINE THE-GLOBAL-ENVIRONMENT (LIST '*TABLE*))

;; EVAL-2 now requires two arguments: the expression to evaluate, and an
;; environment in which to find variables.  This changes the REPL.  Also,
;; instead of just PRINT we use a magic incantation of FORMAT that lets
;; PRINT print circular structures without getting in an infinite
;; loop, because someone might try to print a procedure.

(define (scheme-2)
  (display "Scheme-2: ")
  (flush)
  (print (format #f "~w" (eval-2 (read) THE-GLOBAL-ENVIRONMENT)))
  (scheme-2))

;; Comments on EVAL-2 vs. EVAL-1:

;; EVAL-2 takes the current environment as an argument.

;; Here are the four expression types:
;;    1. self-evaluating (a/k/a constant) expressions: numbers, #t, etc.
;;    2. symbols (variables)
;;    3. special forms (in this evaluator, just QUOTE, IF, LAMBDA, and DEFINE)
;;    4. procedure calls (can call a primitive or a LAMBDA-generated procedure)

;; 1.  No change to handling of self-evaluating expressions.  They don't
;; have to refer to the environment because their values are constant.
;; Since we aren't using substitution, we can remove the kludge in scheme-1
;; wherein an STk procedure is considered a self-evaluating expression.

;; 2.  Now we have local variables, so we look up variables in the
;; current environment, which is a table.  If we don't find the name in
;; the environment, we continue to cheat by asking STk for a global
;; value, so that we inherit all the Scheme primitives.

;; 3.  The handling of QUOTE is unchanged.

;; IF is almost unchanged, but the recursive calls to EVAL-2 require
;; the environment as a second argument.

;; LAMBDA is handled differently, because a procedure is now something
;; more than just its defining text.  It must also remember the
;; environment in which it was created (the right bubble in SICP
;; environment diagrams).

;; To handle internal definitions, we have to allow more than one
;; expression in a procedure body.  (This affects APPLY-2.)

;; Don't try to print SCHEME-2 procedures in STk!  The data structure
;; that represents the procedure is circular.  (It includes the environment,
;; which generally includes a binding whose value is the procedure.)  But
;; you can use the magic incantation
;; 	(print (format #f "~w" foo))
;; to print circular structures without looping.

;; DEFINE is a new special form.  It extends the current environment with
;; a new name-value pair, using the PUT procedure for table updating.

;; Note that this DEFINE does not handle the shortcut notation for
;; defining procedures!  You have to say
;;	(define foo (lambda (x) ...))
;; and not
;;	(define (foo x) ...)

;; 4.  Procedure calling is unchanged except that the recursive calls to
;; EVAL-2 require the environment as an argument.  (But when we get to APPLY-2
;; we'll have to remember that a procedure isn't just a lambda expression.)

(define (eval-2 exp ENV)				; second arg is env
  (cond ((constant? exp) exp)
	((symbol? exp) (LOOKUP EXP ENV))		; look in environment
	((quote-exp? exp) (cadr exp))
	((if-exp? exp)
	 (if (eval-2 (cadr exp) ENV)
	     (eval-2 (caddr exp) ENV)
	     (eval-2 (cadddr exp) ENV)))
	((lambda-exp? exp) (MAKE-PROC EXP ENV))		; procs include env
	((DEFINE-EXP? EXP) (PUT (CADR EXP)		; the DEFINE form
				(EVAL-2 (CADDR EXP) ENV)
				ENV)
	 		   'OKAY)
	((pair? exp) (apply-2 (eval-2 (car exp) ENV)
			      (map (LAMBDA (E) (EVAL-2 E ENV)) (cdr exp))))
	(else (error "bad expr: " exp))))


;; Comments on APPLY-2 vs. APPLY-1:

;; Primitive procedure calling is unchanged.

;; But user-defined procedures are no longer invoked by substitution!
;; Instead, we just EVAL-2 the body *in a new environment* that we
;; create by adding bindings for the procedure's parameters to the
;; environment in which the procedure was created.

;; Note that EXTEND-ENVIRONMENT makes a new table, with a new header
;; pair, even though the new table starts with the same association
;; list as the environment we're extending.  This is important because
;; the new bindings we add should affect only this procedure call, not
;; the enclosing environment.

;; A procedure body is now a list of expressions, not just one
;; expression, so we invent EVAL-SEQUENCE to evaluate them.

(define (apply-2 proc args)
  (cond ((procedure? proc)	; use underlying Scheme's APPLY
	 (apply proc args))
	((LAMBDA-PROC? proc)
	 (EVAL-SEQUENCE (PROC-BODY PROC)
			(EXTEND-ENVIRONMENT (PROC-PARAMS PROC)
					    ARGS
					    (PROC-ENV PROC))))
	(else (error "bad proc: " proc))))

(DEFINE (EVAL-SEQUENCE EXPS ENV)
  (IF (NULL? (CDR EXPS))	; unusual base case so that we
      (EVAL-2 (CAR EXPS) ENV)	; return the value of the last expr
      (BEGIN (EVAL-2 (CAR EXPS) ENV)
	     (EVAL-SEQUENCE (CDR EXPS) ENV))))

(DEFINE (EXTEND-ENVIRONMENT PARAMS ARGS ENV)
  (LET ((NEW-ENV (CONS '*TABLE* (CDR ENV))))
    (DEFINE (EE-LOOP PARAMS ARGS)
      (IF (NULL? PARAMS)
	  NEW-ENV
	  (BEGIN (PUT (CAR PARAMS) (CAR ARGS) NEW-ENV)
		 (EE-LOOP (CDR PARAMS) (CDR ARGS)))))
    (EE-LOOP PARAMS ARGS)))


;; Some trivial helper procedures:

(define (constant? exp)
  (or (number? exp) (boolean? exp) (string? exp)))

(define (exp-checker type)
  (lambda (exp) (and (pair? exp) (eq? (car exp) type))))

(define quote-exp? (exp-checker 'quote))
(define if-exp? (exp-checker 'if))
(define lambda-exp? (exp-checker 'lambda))
(DEFINE DEFINE-EXP? (EXP-CHECKER 'DEFINE))


;; Data abstraction for procedures:

(DEFINE (MAKE-PROC EXP ENV)
  (LIST 'PROCEDURE EXP ENV))

(DEFINE LAMBDA-PROC? (EXP-CHECKER 'PROCEDURE))

(DEFINE PROC-LAMBDA CADR)
(DEFINE PROC-ENV CADDR)

(DEFINE (PROC-PARAMS PROC)
  (CADR (PROC-LAMBDA PROC)))

(DEFINE (PROC-BODY PROC)	; note CDDR not CADDR because
  (CDDR (PROC-LAMBDA PROC)))	; a body can be more than one expr


;; Environment (table) maintenance

;; PUT is different from the one in the book because if we add a new
;; entry with the same key as an old entry (a new variable with the
;; same name as an old one), we don't want to modify the old pair,
;; which might still be valid in an outer environment.  This will be
;; the case in a situation like
;;	(define (foo x)
;;	  (define (baz x)
;;	    ...)
;;	  ...)

(DEFINE (LOOKUP VAR ENV)
  (LET ((RESULT (ASSOC VAR (CDR ENV))))
    (IF RESULT
	(CDR RESULT)
	(EVAL VAR))))			; Not in env, ask STk

(DEFINE (PUT VAR VAL ENV)
  (SET-CDR! ENV (CONS (CONS VAR VAL) (CDR ENV))))

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

;; Sample evaluation, using a primitive as argument to MAP:

; Scheme-2: (define map
; 	      (lambda (f seq)
; 	        (if (null? seq)
; 		    '()
; 		    (cons (f (car seq)) (map f (cdr seq))))))
; okay
; Scheme-2: (map first '(the rain in spain))
; (t r i s)