;; Starter code for HW4 (which is also the code from lecture 5)

;; ----------------------------------------
;; Parser

;; First, we describe high-level classes of tokens, like numbers 
;; and ids (i.e., the ones we defined as direct sets in the
;; first lecture):

(define scanner-spec
  '((white-sp
     (whitespace)                           skip)
    (id
     (letter (arbno (or letter digit "?"))) make-symbol)
    (number
     (digit (arbno digit))                  make-number)))

;; Then we write the BNF in a paritcular format:

(define grammar
  '((program (expression)
             a-program) ;; we leave off field names in this form
    
    (expression (number)
                lit-exp)
    (expression (id)
                var-exp)
    (expression (primitive 
                 "(" (separated-list expression ",")")")
                primapp-exp)
    (expression ("if" expression "then" expression 
                 "else" expression)
                if-exp)
    (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)))

;; scan&parse : string -> program
;;  Parses one program (provided in a string)
(define scan&parse
  (sllgen:make-string-parser scanner-spec grammar))


;; The parsing support can even generate the define-datatype
;;  expressions for us, so the ones above are not needed:
(sllgen:make-define-datatypes scanner-spec grammar)

;; ----------------------------------------
;; Evaluator

;; eval-program : program -> num
;; 
;;   (eval-program (a-program (lit-exp 0))) = 0
;;   (eval-program (a-program (var-exp 'x))) = error
;;   (eval-program (a-program (primapp-exp
;;                                 (add-prim)
;;                                 (list (lit-exp 1)
;;                                       (lit-exp 2)))) = 3
(define (eval-program prog)
  (cases program prog
    (a-program (exp) (eval-expression exp (empty-env)))))

;; eval-expression : expression env -> num
;;
;;  (eval-expression (lit-exp 0) (empty-env)) = 0
;;  (eval-expression (var-exp 'x) 
;                    (extend-env '(x y) '(1 2) (empty-env))) = 1
;;  ... and more examples, based on programs above ...
;;
(define (eval-expression expr env)
  ;; (eopl:printf "(eval-expression ~a ~a)~n" expr env)
  (cases expression expr
    (lit-exp (n) n)
    (var-exp (sym) (apply-env env sym))
    (primapp-exp (prim loe) 
                 (apply-prim prim (eval-rands loe env)))
    (if-exp (test nonzero-branch zero-branch)
            (if (zero? (eval-expression test env))
                (eval-expression zero-branch env)
                (eval-expression nonzero-branch env)))
    (let-exp (los loe body)
             (eval-expression body
                              (extend-env los
                                          (eval-rands loe env)
                                          env)))))

;; <list-of-expr> ::= '()
;;                ::= (cons <expr> <list-of-expr>)

;; eval-rands : list-of-expr env -> list-of-num
;;   takes a list of expression,andproduces the corresponding
;;    list of values after evaluating the expressions
(define (eval-rands loe env)
  (cond
    [(null? loe) '()]
    [else  (cons (eval-expression (car loe)env)
                 (eval-rands (cdr loe) env))]))


;; apply-prim : primitive list-of-nums -> num
;;  (apply-prim (add-prim) '(0 3)) = 3
;;  (apply-prim (sub-prim) '(1 2)) = -1
(define (apply-prim prim lon)
  ;; (eopl:printf "(apply-prim ~a ~a)~n" prim lon)
  (cases primitive prim
    [add-prim () (+ (car lon) (cadr lon))]
    [subtract-prim () (- (car lon) (cadr lon))]
    [mult-prim () (* (car lon) (cadr lon))]
    [incr-prim () (+ 1 (car lon))]
    [decr-prim () (- (car lon) 1)]))

;; ----------------------------------------
;; Read-eval-print:

;; Provides a prompt that reads programs and evals them:
(define read-eval-print
  (sllgen:make-rep-loop
   "-->" 
   eval-program
   (sllgen:make-stream-parser scanner-spec grammar)))



;; ----------------------------------------
;; Environments:

;; <env> ::= '()
;;       ::= (cons (cons <symbol> <number>) <env>)

;; empty-env : -> env
(define (empty-env) '())

;; extend-env : list-of-symbol list-of-number env -> env
(define (extend-env names vals env)
  (letrec ([make-pairs
            ;; This local function takes a list of names
            ;; and a list of values and creates a list
            ;; of pairs of name and value.
	    (lambda (names vals)
	      (cond
	       [(null? names) '()]
	       [else (cons (cons (car names) (car vals))
			   (make-pairs (cdr names) (cdr vals)))]))])
    ;; Add new pairs to old environment:
    (append (make-pairs names vals) env)))

;; apply-env : env symbol -> num
(define (apply-env env s)
  (cond
   [(null? env) (eopl:error 'apply-env 
                            "no binding for variable: ~a" s)]
   [else (cond
           ;; Check whether the first binding is the one we're
           ;;  looking for
           [(eq? (car (car env)) s) (cdr (car env))]
           ;; If not, look in the rest of the environment:
           [else (apply-env (cdr env) s)])]))