;; Let's look again at how our interpreter so far (with proc)
;; works.
;; 
;; Suppose we want to eval
;;    proc (x) +(x,1)
;; Let's look at every step through `eval-expression'.
;;
;; `eval-expression' takes two arguments: an expression
;;  and an environment. Because it will be more conveneient,
;;  we'll write them in the opposite order. Also, we'll
;;  use abbreviations:
;;
;;     * {} will be the empty environment
;;     * {v=e, {}} is an extension of the empty environment,
;;       mapping "v" (an id) to "e" (a value).
;;     * <x, expr, env> will be a closure, where "x" is the
;;       variable (or variables) for the closure's formal
;;       arguments, "expr" is the closure body, and "env"
;;       is an environment.
;;    * we'll show expressions in concrete syntax
;;    * we'll show nested calls to `eval-expression'
;;      by prefixing them with ">>"
;;
;; So the evaluation of proc(x)+(x,1) is:
;;
;;  {} proc(x)+(x,1)    => <x,+(x,1),{}>
;;
;; ----------------------------------------
;; Another example:
;;
;; {} let y = 2 in
;;      let f = proc (x) +(x, y)
;;        in (f 10)
;; >> {} 2 => 2
;; {y=2,{}} let f=proc(x)+(x,y) in (f 10)
;; >> {y=2,{}} proc(x)+(x,y) => <x,+(x,y),{y=2,{}}>
;; {f=<x,+(x,y),{y=2,{}}>,{y=2,{}}} (f 10)
;; >> {f=<x,+(x,y),{y=2,{}}>,{y=2,{}}} f
;;                               => <x,+(x,y),{y=2,{}}>
;; >> {f=<x,+(x,y),{y=2,{}}>,{y=2,{}}} 10 => 10
;; {x=10,{y=2,{}}} +(x,y)
;; >> {x=10,{y=2,{}}} x   => 10
;; >> {x=10,{y=2,{}}} y   => 2
;; => 12
;; 
;; ----------------------------------------
;; {} let y = 2 in
;;      let f = proc (x) +(x, y) in
;;        let y = 3
;;          in (f 10)
;; {y=2,{}} let f=proc(x)+(x,y) in let y=3 in (f 10)
;; >> {y=2,{}} proc(x)+(x,y) => <x,+(x,y),{y=2,{}}>
;; {f=<x,+(x,y),{y=2,{}}>,{y=2,{}}} let y=3 in (f 10)
;; {y=3,{f=<x,+(x,y),{y=2,{}}>,{y=2,{}}}} (f 10)
;; >> {y=3,{f=<x,+(x,y),{y=2,{}}>,{y=2,{}}}} f
;;               => <x,+(x,y),{y=2,{}}>
;; >> {...} 10 => 10
;; {x=10,{y=2,{}}} +(x,y)
;; =>  12
;; 
;; ----------------------------------------
;; Here's an example showing the power of functions to
;; express data, such as pairs:
;;
;; {} let cons = proc(a,d) proc(f) (f a d)
;;        car = proc(p) (p proc(a,d)a)
;;        cdr = proc(p) (p proc(a,d)d)
;;    in (car (cons 2 0))
;;
;; >> {} proc(a,d) proc(f)(f a d) =>
;;                        <a d, proc(f)(f a d), {}>
;; >> {} proc(p) (p proc(a,d)a) => <p, (p proc(a,d)a), {}>
;; >> {} proc(p) (p proc(a,d)d) => <p, (p proc(a,d)d), {}>
;; E={cons=<a d, proc(f)(f a d), {}>
;;    car=<p, (p proc(a,d)a), {}>, cdr=..., {}} 
;;   (car (cons 2 0))
;; >> E car  =>  <p, (p proc(a,d)a), {}>
;; >> E (cons 2 0)
;; >> >> E cons => <a d, proc(f)(f a d), {}>
;; >> >> E 2 => 2
;; >> >> E 0 => 0
;; >> {a=2 d=0,{}} proc(f)(f a d)
;;                           => <f,(f a d), {a=2 d=0,{}}>
;; {p=<f, (f a d), {a=2 d=0, {}}>, {}} (p proc(a,d)a)
;; >> {p=<f, (f a d), {a=2 d=0, {}}>, {}} p
;;                      => <f, (f a d), {a=2 d=0, {}}>
;; >> {p=<f, (f a d), {a=2 d=0, {}}>, {}} proc(a,d)a
;;    = <a d, a, {p=<f, (f a d), {a=2 d=0, {}}>, {}}>
;; E2={f=<a d, a, {p=<f, (f a d), {a=2 d=0, {}}>, {}}>,
;      {a=2 d=0, {}}} (f a d)
;; >> E2 f => <a d, a, {p=<f,(f a d),{a=2 d=0, {}}>,{}}>
;; >> E2 a => 2
;; >> E2 d => 0
;; {a=2 d=0, {p=<f,(f a d),{a=2 d=0, {}}>,{}}} a
;; 2

;; ========================================
;; Now, lets add letrec to our language.
;; How does it evaluate?
;;
;; First try:
;;
;; {} letrec f = proc(x)(f x) in (f 10)
;; >> {} proc(x)(f x)  =>   <x,(f x),{}>
;; {f=<x,(f x),{}>} (f 10)
;; >> {f=<x,(f x),{}>} f  => <x,(f x),{}>
;; >> {...} 10  => 10
;; {x=10, {}} (f x)
;; >> {x=10, {}} f   => 
;;
;; Because we tried to eval "letrec" like "let", it didn't
;; work. Try again, but eval the right-hand side of the
;; letrec in an environment with a binding for f:
;; 
;; {} letrec f = proc(x)(f x) in (f 10)
;; >> {f=...} proc(x)(f x)
;; 
;; but what goes in place of "..."? We'd need the
;; closure to make the environment, but we need the
;;  envrionment to make the closure.
;;
;; ----------------------------------------
;; The solution is to delay creation of the closure until
;; we try to get it from the environment. We'll say that
;; {f=REC[x, expr], ...} means: create a closure for f
;; when needed, using the formal variable "x", closure
;; body "expr", and the immediately enclosing environment.
;; This will work because we'll restrict the right-hand
;; side of a letrec to be a proc.
;;
;; {} letrec f = proc(x)(f x) in (f 10)
;; {f=REC[x,(f x)], {}} (f 10)
;; >> {f=REC[x,(f x)], {}}  f => 
;;                     <x, (f x), {f=REC[x,(f x)], {}}>
;; >> {...} 10 => 10
;; {x=10, {f=REC[x,(f x)], {}}} (f x)
;; >> {x=10, {f=REC[x,(f x)], {}}} f =>
;;          <x, (f x), {f=REC[x,(f x)], {}}>
;; >> {x=10, {f=REC[x,(f x)], {}}} x => 10
;; {x=10, {f=REC[x,(f x)], {}}} (f x)
;; [...same as before, forever...]

;; To implement this, we need a new way to build environments:
;;  recursively-extend-env.

;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;

(define the-lexical-spec
  '((whitespace (whitespace) 
                skip)
    (id (letter (arbno (or letter digit "?")))
        make-symbol)
    (number ((or "" "-" "+") digit (arbno digit))
            make-number)))

(define the-grammar
  '((program (expression) a-program)

    (expression (number) lit-exp)
    (expression (id) var-exp)
    (expression
      (primitive "(" (separated-list expression ",") ")")
      primapp-exp)
    (expression ("true") true-exp)
    (expression ("false") false-exp)
    (expression ("let"
                 (arbno id "=" expression)
                 "in"
                 expression)
                let-exp)
    (expression ("proc"
                 "(" (separated-list id ",") ")"
                 expression)
                proc-exp)
    (expression ("(" expression (arbno expression) ")")
                app-exp)
    (expression ("if" expression
                 "then" expression
                 "else" expression)
                if-exp)
    (expression ("letrec"                            ;; <<<<<
                 id "=" 
                 "proc" "(" (separated-list id ",") ")"
                 expression
                 "in" expression)
                letrec-exp)
    
    (primitive ("+")     add-prim)
    (primitive ("-")     subtract-prim)
    (primitive ("*")     mult-prim)
    (primitive ("add1")  incr-prim)
    (primitive ("sub1")  decr-prim)
    (primitive ("or")    or-prim)))

(sllgen:make-define-datatypes the-lexical-spec
                              the-grammar)

(define-datatype
 proc proc?
 (closure (ids (list-of symbol?))
          (body-exp expression?)
          (env environment?)))

;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

; eval-program : program -> expval
;
; Evaluates the given program, using an environment that
;  binds i, v, and x to 1, 5, and 10, respectively.
;
;   (eval-program (a-program (lit-exp 0))) = 0
;   (eval-program (a-program (var-exp 'a))) = error
;   (eval-program (a-program (var-exp 'x))) = 10
;   (eval-program (a-program (primapp-exp
;                             (add-prim)
;                             (list (lit-exp 1)
;                                   (lit-exp 2))))) = 3
;
(define eval-program 
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-expression body (init-env))))))

; eval-expression : expression env -> expval
;
; Evaluates an expression in the given environment.
;
;   (eval-expression (lit-exp 0)
;                     (empty-env)) = 0
;   (eval-expression (var-exp 'x)
;                     (empty-env)) = error
;   (eval-expression (var-exp 'x))
;                     (extend-env '(i v x) 
;                                 '(1 5 10)
;                                 (empty-env))) = 10
;   (eval-expression (primapp-exp
;                     (add-prim)
;                     (list (lit-exp 1)
;                           (lit-exp 2)))
;                    (empty-env)) = 3
;   (eval-expression (primapp-exp
;                     (or-prim)
;                     (list (true-exp) (false-exp))) = #t
;   (eval-expression (let-exp
;                     (list 'x 'y)
;                     (list (lit-exp 10) (lit-exp 7))
;                     (primapp-exp (add-prim)
;                                  (var-exp 'x)
;                                  (var-exp 'y))))) = 17
;
(define eval-expression 
  (lambda (exp env)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env env id))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands env)))
          (apply-primitive prim args)))
      (true-exp () #t)
      (false-exp () #f)
      (let-exp (ids exps body-exp) 
               (eval-expression
                body-exp ;; expression
                (extend-env
                 ids ;; list-of-sym
                 (eval-rands exps env)
                 env)))
      (proc-exp (ids body-exp)
                (closure ids body-exp env))
      (app-exp (rator rands)
               (let ([func (eval-expression rator env)]
                     [args (eval-rands rands env)])
                 (apply-proc func args)))
      (if-exp (test then else)
              (if (zero? (eval-expression test env))
                  (eval-expression else env)
                  (eval-expression then env)))
      (letrec-exp (func-id arg-ids func-exp body-exp)  ;; <<<<<<<
                  (eval-expression
                   body-exp
                   (recursively-extend-env
                    (list func-id)
                    (list arg-ids)
                    (list func-exp)
                    env))))))

; apply-proc : proc list-of-expval -> expval
(define (apply-proc func args)
  (cases proc func
         (closure (ids body-exp env)
                  (eval-expression
                   body-exp
                   (extend-env
                    ids
                    args
                    env)))))

; eval-rands : list-of-expression env -> list-of-expval
(define eval-rands
  (lambda (rands env)
    (map (lambda (x) (eval-rand x env)) rands)))

; eval-rand : expression env -> expval
(define eval-rand
  (lambda (rand env)
    (eval-expression rand env)))

; apply-primitive : primitive list-of-expval -> expval
;  (apply-prim (add-prim) '(0 3)) = 3
;  (apply-prim (sub-prim) '(1 2)) = -1
(define apply-primitive
  (lambda (prim args)
    (cases primitive prim
      (add-prim  () (+ (car args) (cadr args)))
      (subtract-prim () (- (car args) (cadr args)))
      (mult-prim  () (* (car args) (cadr args)))
      (incr-prim  () (+ (car args) 1))
      (decr-prim  () (- (car args) 1))
      (or-prim () (or (car args) (cadr args))))))

; init-env :  -> env
(define init-env
  (lambda () (empty-env)))

;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;

;; Abstract envrionment datatype implemenation.

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
    (syms (list-of symbol?))
    (vec vector?)    ; can use this for anything.
    (env environment?))
  (recursively-extended-env-record         ;; <<<<<<<<<<
   (func-ids (list-of symbol?))
   (arg-idss (list-of (list-of symbol?)))
   (func-exps (list-of expression?))
   (old-env environment?)))

; empty-env : -> env
(define empty-env
  (lambda ()
    (empty-env-record)))

; extend-env : list-of-sym list-of-denval env -> env 
(define extend-env
  (lambda (syms vals env)
    (extended-env-record syms (list->vector vals) env)))

; recursively-extend-env                      <<<<<<<<<<<
(define recursively-extend-env
  (lambda (func-ids arg-idss func-exps old-env)
    (recursively-extended-env-record
     func-ids arg-idss func-exps old-env)))

; apply-env : env sym -> denval
(define apply-env
  (lambda (env sym)
    (cases environment env
      (empty-env-record ()
        (eopl:error 'apply-env "No binding for ~s" sym))
      (extended-env-record (syms vals env)
        (let ((position (env-find-position sym syms)))
          (if (number? position)
              (vector-ref vals position)
              (apply-env env sym))))
      (recursively-extended-env-record     ;; <<<<<<<<<<<
       (func-ids arg-idss func-exprs old-env)
        (let ((position 
               (env-find-position sym func-ids)))
          (if (number? position)
              (closure (list-ref arg-idss position)
                       (list-ref func-exprs position)
                       env)
              (apply-env old-env sym))))
       
       
       )))

;; Environment helper functions

; env-find-position : sym list-of-symbols -> num-or-#f
(define env-find-position 
  (lambda (sym los)
    (list-find-position sym los)))

; list-find-position : sym list-of-symbols -> num-or-#f
(define list-find-position
  (lambda (sym los)
    (list-index (lambda (sym1) (eqv? sym1 sym)) los)))

; list-index : pred list-of-symbols -> num-or-#f
(define list-index
  (lambda (pred ls)
    (cond
      ((null? ls) #f)
      ((pred (car ls)) 0)
      (else (let ((list-index-r 
                   (list-index pred (cdr ls))))
              (if (number? list-index-r)
                (+ list-index-r 1)
                #f))))))

;;;;;;;;;;;;;;;; top level ;;;;;;;;;;;;;;;;

; read-eval-print : -> [loops forever]
(define read-eval-print
  (lambda ()
    ((sllgen:make-rep-loop "-->"
			   eval-program
                           (sllgen:make-stream-parser
                            the-lexical-spec
                            the-grammar)))))

(define scan&parse
  (sllgen:make-string-parser the-lexical-spec
                             the-grammar))

(define (run string)
  (eval-program (scan&parse string)))