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

; run : string -> num
;
; Takes a string respresting concrete syntax and
; evaluates it, returning the result.
;
;  (run "+(1,2)") = 3
;
(define run
  (lambda (string)
    (eval-program (scan&parse string))))

; read-eval-print : -> [loops forever]
;
; Creates a prompt in DrScheme for typing programs
; in concrete syntax and getting back a result.
;
(define read-eval-print
  (lambda ()
    ((sllgen:make-rep-loop "-->"
			   eval-program
                           (sllgen:make-stream-parser
                            the-lexical-spec
                            the-grammar)))))

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

; scan&parse : string -> program
;
; Takes a program in concrete syntax (as a string) and
; returns the program in abstract syntax.
;
;  (scan&parse "+(1,2)") = (a-program
;                           (primapp-exp
;                            (add-prim)
;                            (list (lit-exp 1) (lit-exp 2))))
;
(define scan&parse
  (sllgen:make-string-parser the-lexical-spec the-grammar))

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

; eval-program : program -> num
;
; 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 -> num
;
; 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
;
(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))))))

; eval-rands : list-of-expression env -> list-of-num
;
; Evaluates each expression in the list with the given
; environment, producing a list of results.
;
;  (eval-rands '() (empty-env)) = _()_
;  (eval-rands (list (lit-exp 0) (vap-exp 'x))
;              (extend-env '(x) '(3) (empty-env))) = _(0 3)_
;
(define eval-rands
  (lambda (rands env)
    (map (lambda (x) (eval-rand x env)) rands)))

; eval-rand : expression env -> num
;
; Evaluates a single operand (an expression) in the 
; given environment.
;
;  [Test cases are the same as for eval-expression.]
;
(define eval-rand
  (lambda (rand env)
    (eval-expression rand env)))

; apply-primitive : primitive list-of-num -> num
;
; Applies a primitive to a list of values. The number of values
; in the list must be the expected number of values for the
; primitive. (If the number is wrong, an error may or may not be
; reported.)
;
;  (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)))))

; init-env :  -> env
;
; Creates an environment binding i, v, and x to
; 1, 5, and 10, respectively.
; 
(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-num env -> env 
(define extend-env
  (lambda (syms vals env)
    (extended-env-record syms (list->vector vals) env)))

; apply-env : env sym -> num
(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))))))