;; Add call-by-reference arguments

;; An expval is
;;   * a number
;;   * a proc
;;
;; A denval is a location

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

(define-datatype
 loc location?
 (a-location (val vector?)))

(define (expval? v)
  (or (number? v) (proc? v)))

;;;;;;;; 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 ("let"
                 (arbno id "=" expression)
                 "in"
                 expression)
                let-exp)
    ;; >> changed id for argument to var
    (expression ("proc"
                 "(" (separated-list var ",") ")"
                 expression)
                proc-exp)
    (expression ("(" expression (arbno expression) ")")
                app-exp)
    (expression ("if" expression
                 "then" expression
                 "else" expression)
                if-exp)
    (expression ("set" id "=" expression)
                set-exp)
    (expression ("{" expression ";" expression "}")
                begin-exp)
    
    ;; >> var is call-by-value or call-by-ref
    (var (id) cbv-var)
    (var ("&" id) cbr-var)
    
    (primitive ("+")     add-prim)
    (primitive ("-")     subtract-prim)
    (primitive ("*")     mult-prim)
    (primitive ("add1")  incr-prim)
    (primitive ("sub1")  decr-prim)))

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

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

; eval-program : program -> expval
(define eval-program 
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-expression body (empty-env))))))

; eval-expression : expression env -> expval
(define eval-expression 
  (lambda (exp env)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) 
	       ;; >> Env maps names to locations, need
	       ;;    to extract the value
	       (location-val (apply-env env id)))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands env)))
          (apply-primitive prim args)))
      (let-exp (ids exps body-exp) 
               (eval-expression
                body-exp ;; expression
                (extend-env
                 ids ;; list-of-sym
                 (map location (eval-rands exps env))
                 env)))
      (proc-exp (vars body-exp)
                (closure vars
                         body-exp
                         env))
      (app-exp (rator rands)
               (apply-proc
                (eval-expression rator env)
		;; >> special evaluation for arguments:
                (eval-fun-rands rands env)))
      (if-exp (test then else)
              (if (zero? (eval-expression test env))
                  (eval-expression else env)
                  (eval-expression then env)))
      (begin-exp (first second)
                 (begin
                   (eval-expression first env)
                   (eval-expression second env)))
      (set-exp (id rhs)
               (let ([v (eval-expression rhs env)]
                     [loc (apply-env env id)])
		 ;; >> To assign, modify a location's content
                 (location-set! loc v)
                 1)))))

;; An arg is
;;  * expval
;;  * location

; eval-fun-rands : list-of-expr env -> list-of-arg
(define (eval-fun-rands l env)
  (map
   (lambda (expr)
     ;; >> For a var argument, get its locations
     (cases expression expr
       (var-exp (id) (apply-env env id))
       (else (eval-expression expr env))))
   l))

; apply-proc : expval list-of-args -> expval
(define (apply-proc func args)
  (cond
    [(number? func) (eopl:error 'apply-proc "not a func")]
    [(proc? func) (cases proc func
                         (closure (vars body-exp env)
                                  (eval-expression
                                   body-exp
                                   (extend-env
                                    (map var->id vars)
				    ;; >> make a location
				    ;;   as appropriate...
                                    (map
                                     get-arg-location
                                     vars args)
                                    env))))]))

; get-arg-location : var arg ->location
(define (get-arg-location v arg)
  (cond
    [(location? arg)
     ;; >> Argument was a var, and we have its location...
     (cases var v
            (cbv-var (id) 
		     ;; >> Call-by-value; new location
		     ;;    with content of the old one
		     (location (location-val arg)))
            (cbr-var (id) 
		     ;; >> call-by-ref; REUSE location
		     arg))] 
    [(expval? arg)
     ;; >> Argument was not a var; always create a new locations
     (cases var v
            (cbv-var (id) (location arg))
            (cbr-var (id) (location arg)))]))

(define (var->id v)
  (cases var v
         (cbv-var (id) id)
         (cbr-var (id) id)))

(define (location v)
  (a-location (vector v)))

(define (location-val l)
  (cases loc l
         (a-location (vec) (vector-ref vec 0))))

(define (location-set! l v)
  (cases loc l
         (a-location (vec) (vector-set! vec 0 v) )))


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

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

;; Abstract envrionment datatype implemenation.

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
    (syms (list-of symbol?))
    (vec vector?)
    (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)))))

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

;; Examples:
(eval-program (scan&parse "let f = proc(&x) +(x,1) in (f 12)"))
; = 13
(eval-program (scan&parse "let f = proc(x) set x = +(x,1) in let y = 12 in {(f y);y}"))
; = 12
(eval-program (scan&parse "let f = proc(&x) set x = +(x,1) in let y = 12 in {(f y);y}"))
; = 13