;; Extend with function defs for programs.

;; Example:

;;    f(x) = +(x,1) g(y) = (f y) in (g 7)

;;      g is: argument vars: y
;;               body:  (f y)
;;       argument is: 7

;; Another example:

;;    in 10

;;    Even with 0 definitions, we need the "in" keyword

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

;;;;;;;;;;;;;;;; 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
			 (empty-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))) = 1
(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)))
      (let-exp (ids exps body-exp) 
               (eval-expression
                body-exp ;; expression
                (extend-env
                 ids ;; list-of-sym
                 (eval-rands exps env fenv)
                 env)
                fenv))
      (if-exp (test then else)
              (if (zero? (eval-expression test env fenv))
                  (eval-expression else env fenv)
                  (eval-expression then env fenv)))
      (app-exp (id arg-exprs)
               (let ([arg-vals (eval-rands arg-exprs env fenv)]
                     [func (apply-env fenv id)])
                 (cases funcdef func
                        (a-funcdef (arg-ids body-expr)
                                   (eval-expression
                                    body-expr
                                    (extend-env
                                     arg-ids
                                     arg-vals
                                     (empty-env))
                                    fenv))))))))

  
;; Example showing why we eval the funciton body with an empty
;; environment:
;;     f(x) = +(x,y) in let y = 5 in (f +(y,7))
;; This should be an error, not 17.

;; 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)
    (cond
      [(null? rands) '()]
      [else (cons (eval-expression (car rands) env fenv)
                  (eval-rands (cdr rands) env fenv))])))
(define eval-rands
  (lambda (rands env fenv)
    (let ([eval-one (lambda (rand)
                      (eval-expression rand env fenv))])
      (map eval-one rands)))

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

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

;; Abstract envrionment datatype implemenation.

;; <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)
              (map cons names 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)])]))

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