;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file has three parts.                                       ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;==================================================================;;
;; The first part of this file completes the language with first-   ;;
;; order functions that we started in the previous lecture          ;;
;;==================================================================;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A expval is
;;   * number, or
;;   * boolean

;; A denval is
;;   * number, or
;;   * boolean

;; Extend with function defs for programs:
;;
;;    f(x) = +(x,1) g(y) = (f y) in (g 7)
;;      g is: argument vars: y
;               body:  (f y)
;       argument is: 7
;;    in 10

;;;;;;;; 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 ((arbno id funcdef)
              "in"
              expression)
             a-program)

    (funcdef ("(" (arbno id) ")" "=" expression)
             a-funcdef)
    
    (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 ("(" id (arbno expression) ")")
                app-exp)
    (expression ("if" expression
                 "then" expression
                 "else" expression)
                if-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)

;;;;;;;;;;;;;;;; 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 
;                  (list)
;                  (list)
;                  (lit-exp 0))) = 0
;   (eval-program (a-program 
;                  (list 'f)
;                  (list (a-funcdef
;                         (list 'x)
;                         (primapp-exp (inc-prim)
;                                      (list (var-exp 'x)
;                                       ))))
;                  (app-exp 'f (list (lit-exp 1))))) = 2
;
(define eval-program 
  (lambda (pgm)
    (cases program pgm
      (a-program (ids funcdefs body)
        (eval-expression body (init-env)
                         (extend-env
                          ids
                          funcdefs
                          (empty-env)))))))

; eval-expression : expression env env -> expval
;
; Evaluates an expression in the given environment.
;
;   (eval-expression (lit-exp 0)
;                     (empty-env) (empty-env)) = 0
;   (eval-expression (var-exp 'x)
;                     (empty-env) (empty-env)) = error
;
;   (eval-expression (app-exp 'f (list (lit-exp 0)))
;                    (empty-env)
;                    (extend-env
;                     (list 'f)
;                     (list (a-funcdef
;                            (list 'x)
;                            (primapp-exp (incr-prim)
;                                         (var-exp 'x))))
;                     (empty-env)))
(define eval-expression 
  (lambda (exp env fenv)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env env id))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands env fenv)))
          (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 fenv)
                 env)
                fenv))
      ;; Implement application                         <<<<<<<<<<<<<<
      (app-exp (id rands)
               (let ([func (apply-env fenv id)]          ; lookup function
                     [args (eval-rands rands env fenv)]) ; eval args
                 (apply-proc func args fenv)))           ; apply func
      (if-exp (test then else)
              (if (zero? (eval-expression test env fenv))
                  (eval-expression else env fenv)
                  (eval-expression then env fenv))))))

; apply-proc : funcdef list-of-expvals env -> expval   <<<<<<<<<<<<<<
(define (apply-proc def args fenv)
  (cases funcdef def
	 ;; To apply, we eval the body in an environment
	 ;;  extended with bindings for the arguments.
         (a-funcdef (ids body-exp)
                    (eval-expression
                     body-exp
                     (extend-env
                      ids
                      args
		      ;; We start with an *empty* environment
		      ;;  every time we call a function! We
		      ;;  use an empty environment because our
		      ;;  languages uses lecical scope, and function
		      ;;  definitions are outside all bindings.
		      ;;  See example below...
                      (empty-env))
                     fenv))))
  
;; Exmaple showing why we eval the funciton body with an empty
;; environment:
;;     f(x) = +(x,y) in let y = 5 in f(10) 
;; This should be an error, not 15.

;; We also add fenv to all the helper functions.      <<<<<<<<<<<<<

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

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

; 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 ()
    (extend-env
      '(i v x)
      '(1 5 10)
      (empty-env))))

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

;; Abstract envrionment datatype implemenation.
;; >>> Do not modify this part. <<<

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
    (syms (list-of symbol?))
    (vec vector?)    ; can use this for anything.
    (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)))

; 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)))))))

;; 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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;==================================================================;;
;; The next part of this file defines a language with higher-order  ;;
;; functions (i.e., lambda). It's 3.5 in EoPL.                      ;;
;;==================================================================;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A expval is
;;   * number, or
;;   * boolean, or
;;   * proc                          <<<<<<<

;; A denval is
;;   * number, or
;;   * boolean, or
;;   * proc                          <<<<<<<<

;; Extend with proc:                 <<<<<<<<
;;    proc (x) +(x,1)
;;
;;    let f = proc (x) +(x, 1) in (f 10)
;;
;;    let y = 2 in
;;      let f = proc (x) +(x, y)
;;        in (f 10)
;;
;;    let y = 2 in
;;      let f = proc (x) +(x, y)
;;        let y = 3
;;          in (f 10)   ;; should produce 12, not 13
;;
;;    (proc (x) +(x 1)   10)
;;    ((proc (x) proc (y) +(x, y)   1) 2)

;;;;;;;; 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)
                 
    
    (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)))
      ;; Handle proc evaluation.                        <<<<<<<<<
      ;;  Essentially, we just return the proc (its
      ;;  variables and body), but we also remember the
      ;;  current environment, to implement lexical scoping.
      (proc-exp (ids body-exp)
                (closure ids body-exp env))
      ;; Handle application                             <<<<<<<<<
      (app-exp (rator rands)
               (let ([func (eval-expression rator env)] ; eval func expr
                     [args (eval-rands rands env)])     ; eval all arg exprs
                 (apply-proc func args)))               ; apply func
      (if-exp (test then else)
              (if (zero? (eval-expression test env))
                  (eval-expression else env)
                  (eval-expression then env))))))

; apply-proc : proc list-of-expressions -> expval       <<<<<<<<<
(define (apply-proc func args)
  (cases proc func
	 ;; To apply a proc (a closure at this point),
	 ;;  we extract the saved environment, extend it
	 ;;  with bindings for the arguments, and evaluate
	 ;;  the function body.
         (closure (ids body-exp env)
                  (eval-expression
                   body-exp
                   (extend-env
                    ids
                    args
                    env)))))

;; The rest is unchanged.                               <<<<<<<<<

; 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 ()
    (extend-env
      '(i v x)
      '(1 5 10)
      (empty-env))))

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

;; Abstract envrionment datatype implemenation.
;; >>> Do not modify this part. <<<

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
    (syms (list-of symbol?))
    (vec vector?)    ; can use this for anything.
    (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)))

; 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)))))))

;; 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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;==================================================================;;
;; The last part illustrates some uses of `proc' expressions, and   ;;
;; shows how it's powerful enough to implement factorial.           ;;
;; It also shows how an even smaller language (like the one for     ;;
;; HW5) can still imeplement factorial.                             ;;
;;==================================================================;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|

-->let f = proc (x) if x then *(x,(f -(x,1))) else 1
      in (f 10)
Error reported by apply-env:
No binding for f               ;; Due to lexical scope!
                               ;; How do we get around the problem?

;; In Scheme, we could write:
> (letrec ([f
            (lambda (x)
              (if (not (zero? x))
                  (* x (f (- x 1)))
                  1))])
    (f 10))
3628800

;; What if we didn't have letrec?
> (let ([f
         (lambda (x f)
           (if (not (zero? x))
               (* x (f (- x 1) f))
               1))])
    (f 10 f))
3628800

;; Let's try that!
-->let f = proc (x, f) if x then *(x,(f -(x, 1) f))
                              else 1
      in (f 10 f)
3628800

;; In HW5, the language is even smaller: no let, only lambda.
;; But we can transform a let to a lambda with application:
> ((lambda (f) (f 10 f))
   ;; This function gets bound to "f" above:
   (lambda (x f)
     (if (not (zero? x))
         (* x (f (- x 1) f))
         1)))
3628800

;; In HW5, thw language has single-variable functions, only.
;; In general, we can change a 2-variable function and application:
> ((lambda (x y) (+ x y)) 1 2)
3
;; to single-variable function and applications, like this:
> (((lambda (x) (lambda (y) (+ x y))) 1) 2)
3

;; Apply this change to our factorial:
> ((lambda (f) ((f 10) f))
   (lambda (x)
     (lambda (f)
       (if (not (zero? x))
           (* x ((f (- x 1)) f))
           1))))
3628800

|#