;;; Eval
(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        
        ; look up variables in the environments to find their values
        ((variable? exp) (lookup-variable-value exp env))
        
        ; for quote expression, returns the the expression itself 
        ((quoted? exp) (text-of-quotation exp))
        
        ; assignments are recusively called eval to compute the new value to be associated with the variable
        ((assignment? exp) (eval-assignment exp env))
        
        ; define
        ((definition? exp) (eval-definition exp env))
        
        ; if expression requires special processing of its parts
        ((if? exp) (eval-if exp env))
        
        ; lambda must be transferred into an applicable procedure
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        
        ; begin expression requires evaluating its sequence of expressions in the order in which they appear
        ((begin? exp) 
         (eval-sequence (begin-actions exp) env))
        
        ; cond expression is transformed into a nest of if expressions and then evaluated
        ((cond? exp) (eval (cond->if exp) env))
        
        ; with expression is transformed into collection of set! expression and then evaluated
        ((with? exp)
          (eval-sequence-with (with-actions exp) (with-variable exp) env))
        
        ; while
        ((while? exp) (display 'while-expression))
        
        ; procedure application, eval recursively evaluate the operator part and the operands of the operation
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))

;;; Apply
;;; take two arguments --> a procedure and a list of argument
(define (apply procedure arguments)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure procedure arguments))
        ((compound-procedure? procedure)
         (eval-sequence
           (procedure-body procedure)
           (extend-environment
             (procedure-parameters procedure)
             arguments
             (procedure-environment procedure))))
        (else
         (error
          "Unknown procedure type -- APPLY" procedure))))

(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (cons (eval (first-operand exps) env)
            (list-of-values (rest-operands exps) env))))

(define (eval-if exp env)
  (if (true? (eval (if-predicate exp) env))
      (eval (if-consequent exp) env)
      (eval (if-alternative exp) env)))

(define (eval-sequence exps env)
  (cond ((last-exp? exps) (eval (first-exp exps) env))
        (else (eval (first-exp exps) env)
              (eval-sequence (rest-exps exps) env))))

(define (eval-sequence-with exps var env)
  ;(display (first-exp exps))
  ;(display (rest-exps exps))
  (display (make-set! var (first-exp exps)))
  (cond ((last-exp? exps) (eval (make-set! var (first-exp exps)) env))
        (else (eval (make-set! var (first-exp exps)) env)
              (eval-sequence-with (rest-exps exps) var env))))

(define (eval-assignment exp env)
  (set-variable-value! (assignment-variable exp)
                       (eval (assignment-value exp) env)
                       env)
  'ok)

(define (eval-definition exp env)
  (display (definition-variable exp))
  (display (definition-value exp))
  (define-variable! (definition-variable exp)
                    (eval (definition-value exp) env)
                    env)
  'ok)

;(define (eval-with))

#|(define (eval-with exp env)
  (display (with-variable exp))
  (display (with-value exp))
  (define-variable! (with-variable exp)
                    (eval (with-value exp) env)
                    env)
 'ok)|#

;; only self-evaluating items are numbers and strings
(define (self-evaluating? exp)
  (cond ((number? exp) #t)
        ((string? exp) #t)
        (else #f)))

;; quotations have the form (quote <text-of-quotation>)
(define (quoted? exp)
  (tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp))

;; identify lists beginning with a designated symbol
(define (tagged-list? exp tag)
  (if (pair? exp)
      (eq? (car exp) tag)
      #f))

(define (variable? exp) (symbol? exp))

(define (assignment? exp)
  (tagged-list? exp 'set!))

;; variables are represented by symbols 
(define (assignment-variable exp) (cadr exp))

(define (assignment-value exp) (caddr exp))

;; definitions have the forms
;; (define <var> <value>) or
;; (define (<var> <param_1> ... <param_n>)) or
;; (define <var>
;;    (lambda (<param_1> .. <param_n>)
;;        <body>))
(define (definition? exp)
  (tagged-list? exp 'define))

(define (definition-variable exp)
  (if (symbol? (cadr exp))
      (cadr exp)
      (caadr exp)))

(define (definition-value exp)
  (display(cadr exp))
  (if (symbol? (cadr exp))
      (caddr exp)
      (make-lambda (cdadr exp)
                   (cddr exp))))

;; lambda expressions are lists that begin with the symbol lambda
(define (lambda? exp) (tagged-list? exp 'lambda))

(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))

(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))

;; conditions begin with if and have a predicate, a consequencr, and an alternative
(define (if? exp) (tagged-list? exp 'if))

(define (if-predicate exp) (cadr exp))

(define (if-consequent exp) (caddr exp))

(define (if-alternative exp)
  (if (not (null? (cdddr exp)))
      (cadddr exp)
      'false))

;; constructor for if expression, to be used by cond->if tranform cond expression to if expression
(define (make-if predicate consequent alternative)
  (list 'if predicate consequent alternative))

;; constructor for with expression, to be used by with->set tranform cond expression to with expression
(define (make-set! var val)
  (list 'set! var val))

;; begin packages a sequence of expressions in to single expression
(define (begin? exp) (tagged-list? exp 'begin))

(define (begin-actions exp) (cdr exp))

(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))

;; this constructor transfroms a sequence into a single expression
(define (sequence->exp seq)
  (cond ((null? seq) seq)
        ((last-exp? seq) (first-exp seq))
        (else (make-begin seq))))

(define (make-begin seq) (cons 'begin seq))

;; procedure application is any compound expression that is not of one above expression types.
(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))

(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))

;; extract the parts of a cond expression 
(define (cond? exp) (tagged-list? exp 'cond))

(define (cond-clauses exp) (cdr exp))

(define (cond-else-clause? clause)
  (eq? (cond-predicate clause) 'else))

(define (cond-predicate clause) (car clause))

(define (cond-actions clause) (cdr clause))

(define (cond->if exp)
  (expand-clauses (cond-clauses exp)))

(define (expand-clauses clauses)
  (if (null? clauses)
      'false                          ; no else clause
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
            (if (null? rest)
                (sequence->exp (cond-actions first))
                (error "ELSE clause isn't last -- COND->IF"
                       clauses))
            (make-if (cond-predicate first)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest))))))

(define (true? x)
  (not (eq? x #f)))

(define (false? x)
  (eq? x #f))

;;with
(define (with? exp)
  (tagged-list? exp 'with))

(define (with-actions exp) (cddr exp))

(define (with-variable exp)
  ;(if (symbol? (cadr exp))
      ;(cadr exp)
      ;(caadr exp)))
  (cadr exp))

(define (with-value exp)
  ;(if (symbol? (cadr exp))
      ;(caddr exp)
      (make-lambda (cadr exp)
                   (cddr exp)))

;;while
(define (while? exp)
  (tagged-list? exp 'while))

;; this constructor constructs compound procedures from parameters, procedures bodies, and environments
(define (make-procedure parameters body env)
  (list 'procedure parameters body env))

(define (compound-procedure? p)
  (tagged-list? p 'procedure))


(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))

;; Enviroments definitions
;; Environment is a sequence of frames, where each frame is a table of bindings that associate 
;; variables with their corresponding values.
;; Represent an environment as a list of frames 
(define (enclosing-environment env) (cdr env))

(define (first-frame env) (car env))

(define the-empty-environment '())

;; each frame of an environment is represented as a pair of lists: list of the variables bound in that frame and a list of the associated values
(define (make-frame variables values)
  (cons variables values))

(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))

(define (add-binding-to-frame! var val frame)
  (set-car! frame (cons var (car frame)))
  (set-cdr! frame (cons val (cdr frame))))

;; extend environment by a new frame that associates variables with values
(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) base-env)
      (if (< (length vars) (length vals))
          (error "Too many arguments supplied" vars vals)
          (error "Too few arguments supplied" vars vals))))

;; look up a variable in an environment
;; scan the list of variables in the first frames. if found the desired variable, then return the corresponding element in the list of values.
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (car vals))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

;; set varible to new value in a specified environment 
;; scan for the variable and change the corresponding value when we find it
(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

;; define variable
;; search the first first for a binding for the varible, and change the binding if it exists
(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! var val frame))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame)
          (frame-values frame))))

(define (setup-environment)
  (let ((initial-env
         (extend-environment (primitive-procedure-names)
                             (primitive-procedure-objects)
                             the-empty-environment)))
    (define-variable! 'true #t initial-env)
    (define-variable! 'false #f initial-env)
    initial-env))

;[do later] (define the-global-environment (setup-environment))
;; define primitives

(define (primitive-procedure? proc)
  (tagged-list? proc 'primitive))

(define (primitive-implementation proc) (cadr proc))

(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
	(list '+ +)
	(list '- -)
	(list '* *)
	(list '/ /)
	(list 'zero? zero?)
	(list '= =)
	(list '> >)
	(list '< <)
        (list 'list list)
        (list 'append append)
        (list 'equal? equal?)
        ;(list 'with with)
;;      more primitives
        ))

(define (primitive-procedure-names)
  (map car
       primitive-procedures))

(define (primitive-procedure-objects)
  (map (lambda (proc) (list 'primitive (cadr proc)))
       primitive-procedures))

(define (apply-primitive-procedure proc args)
  (let ((arglength (length args))
	(primitive-proc (primitive-implementation proc)))
    (cond ((= arglength 0) (primitive-proc))
	  ((= arglength 1) (primitive-proc (car args)))
	  ((= arglength 2) (primitive-proc (car args)
					   (cadr args)))
	  ((= arglength 3) (primitive-proc (car args)
					   (cadr args)
					   (caddr args)))
	  ((= arglength 4) (primitive-proc (car args)
					   (cadr args)
					   (caddr args)
					   (cadddr args)))
	  (else (error "Too many args to primitive" primitive-proc)))))

(define input-prompt "Eval>> ")
(define output-prompt "Value>> ")

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (if (eq? input 'stop)
	'stopped
	(let ((output (eval input the-global-environment)))
	  (announce-output output-prompt)
	  (user-print output)
	  (driver-loop)))))

(define (prompt-for-input string)
  (newline) (newline) (display string))

(define (announce-output string)
  (newline) (display string) (newline))

(define (user-print object)
  (cond ((compound-procedure? object)
	 (display (list 'compound-procedure
			(procedure-parameters object)
			(procedure-body object)
			'<procedure-env>)))
	(else (display object))))

;;;Following are commented out so as not to be evaluated when
;;; the file is loaded.
(define the-global-environment (setup-environment))
(driver-loop)

#|
;; Sample use
(define (append x y)
  (if (null? x)
      y
      (cons (car x)
            (append (cdr x) y))))

(append '(a b c) '(d e f))

(define (sum x y)
  (+ x y))

(sum 2 3)

(pair? (cons 3 4)) => #f
(null? '()) => error