;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Note: this file contains two version of the language:                    ;;
;;      * one with bools, or, and let added                                 ;;
;;      * one with function defns also added, still in progress             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Extend with true & false
;;     true
;;     false
;;     or(true, false)
;;     or(false, or(true, true))

;; This changes our set of expressed and denoted values:

;; A expval ("expressed value") is
;;   * number, or
;;   * boolean

;; A denval ("denoted value") is
;;   * number, or
;;   * boolean

;; Extend with let:
;;    let x = 5 in +(x,1)
;;    let x = 5 y = 10 in +(x,y)
;;    let x = 5 in let y = 10 in +(x,y)

;; [let addition is 3.4 in EoPL]

;; Changes highlighted below with "<<<<<<<<<<<"

;;;;;;;; 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)
    ;; Added two expression forms for bools:                <<<<<<<<<<<<
    (expression ("true") true-exp)
    (expression ("false") false-exp)
    ;; Added one expression for for let:                    <<<<<<<<<<<<
    (expression ("let"
                 (arbno id "=" expression)
                 "in"
                 expression)
                let-exp)
    
    (primitive ("+")     add-prim)
    (primitive ("-")     subtract-prim)
    (primitive ("*")     mult-prim)
    (primitive ("add1")  incr-prim)
    (primitive ("sub1")  decr-prim)
    ;; Added one primitive to operate on bools:             <<<<<<<<<<<<
    (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 (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.
;
;   ... old examples ...
;
; New examples:                                          <<<<<<<<<<<
;
;   (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)))
      ;; Add clauses for boolean constrants:             <<<<<<<<<<<
      (true-exp () #t)
      (false-exp () #f)
      ;; Add clause for "let"                           <<<<<<<<<<
      (let-exp (ids exps body-exp) 
               (eval-expression
                body-exp ;; expression
                (extend-env
                 ids ;; list-of-sym
                 (eval-rands exps env) ;; eval all right-hand sides
		                       ;; before binding anything
                 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))
      ;; Added or primitive:                           <<<<<<<<<<<<
      (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.
;; Only change from HW4 template is "num" replaced     <<<<<<<<<<<<
;;  with "denval" in contracts:

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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Version two: adding function definitions (still in progress)            ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Not quite EoPL 3.5. Our functions for now are "first-order".

;; Expressed and denoted value sets unchanged:

;;  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)
;; 0 defs is also ok:
;;    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
  '(;; Changed the grammar for a program:                 <<<<<<<<<<
    (program ((arbno id funcdef)
              "in"
              expression)
             a-program)

    ;; Added a production for funcdefs:                  <<<<<<<<<<<
    (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)
    ;; Added expression form for function application:     <<<<<<<<
    (expression ("(" id (arbno expression) ")")
                app-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.
;
; Now examples contain function definitions:            <<<<<<<<<<
;
;   (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)
			 ;; We put function definitions    <<<<<<<<<
			 ;;  in their own environment:
                         (extend-env
                          ids
                          funcdefs
                          (empty-env)))))))

; eval-expression : expression env env -> expval
;                                  ^^^ new env in contract <<<<<<<<<
;
; 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
;   etc. ... add empty env for functions to old examples
;
; New example to show function def and application:        <<<<<<<<<
;
;   (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)
    (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)))
      ;; New function-application case goes here...           <<<<<<<<
      )))

;; We haven't yet looked at the following...                  <<<<<<<

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

;;; The rest is the same as before