#lang eopl
;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;

(define the-lexical-spec
  '((whitespace (whitespace) skip)

    (comment ("%" (arbno (not #\newline))) skip)

    (identifier
     (letter (arbno (or letter digit "_" "-" "?"))) symbol)

    (number (digit (arbno digit)) number)

    (number ("-" digit (arbno digit)) number)
    ))

(define the-grammar
  '((program (expression) a-program)

    (expression (number) const-exp)

    (expression("-" "(" expression "," expression ")")diff-exp)

    (expression("*" "(" expression "," expression ")")mult-exp)

    (expression("+" "(" expression "," expression ")")add-exp)

    (expression("/" "(" expression "," expression ")")div-exp)

    (expression("minus" "(" expression ")") minus-exp)

    (expression ("zero?" "(" expression ")") zero?-exp)

    (expression
     ("if" expression "then" expression "else" expression) if-exp)

    (expression (identifier) var-exp)

    (expression
     ("let" (arbno identifier "=" expression) "in" expression) let-exp)

    (expression
     ("letrec" identifier "(" identifier ")" "=" expression
               "in" expression) letrec-exp)

    (expression ("proc" "(" identifier ")" expression) proc-exp)

    (expression ("(" expression expression ")") call-exp)

    ))

;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;

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

(define show-the-datatypes
  (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))

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

(define just-scan
  (sllgen:make-string-scanner the-lexical-spec the-grammar))

;;;;;    ENVIRONMENT

(define-datatype environment environment?
  (empty-env)
  (extend-env
   (bvar symbol?)
   (bval expval?)
   (saved-env environment?))
  (extend-env-rec
   (id symbol?)
   (bvar symbol?)
   (body expression?)
   (saved-env environment?)))

(define (apply-env env search-sym)
    (cases environment env
      (empty-env ()
                 (eopl:error 'apply-env "No binding for ~s" search-sym))
      (extend-env (var val saved-env)
                  (if (eqv? search-sym var)
                      val
                      (apply-env saved-env search-sym)))
      (extend-env-rec (p-name b-var p-body saved-env)
                      (if (eqv? search-sym p-name)
                          (proc-val (procedure b-var p-body env))
                          (apply-env saved-env search-sym)))))



(define (init-env)
  (extend-env
   'i (num-val 1)
   (extend-env
    'v (num-val 5)
    (extend-env
     'x (num-val 10)
     (empty-env)))))


;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;

;;; an expressed value is either a number, a boolean or a procval.

(define-datatype expval expval?
  (num-val
   (value number?))
  (bool-val
   (boolean boolean?))
  (proc-val
   (proc proc?)))

;;; extractors:

;; expval->num : ExpVal -> Int
(define expval->num
  (lambda (v)
    (cases expval v
      (num-val (num) num)
      (else (expval-extractor-error 'num v)))))

;; expval->bool : ExpVal -> Bool
(define expval->bool
  (lambda (v)
    (cases expval v
      (bool-val (bool) bool)
      (else (expval-extractor-error 'bool v)))))

;; expval->proc : ExpVal -> Proc
(define expval->proc
  (lambda (v)
    (cases expval v
      (proc-val (proc) proc)
      (else (expval-extractor-error 'proc v)))))

(define expval-extractor-error
  (lambda (variant value)
    (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
                variant value)))


;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;

;; proc? : SchemeVal -> Bool
;; procedure : Var * Exp * Env -> Proc
(define-datatype proc proc?
  (procedure
   (var symbol?)
   (body expression?)
   (env environment?)))


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

;; value-of-program : Program -> ExpVal
(define (value-of-program pgm)
  (cases program pgm
    (a-program (exp1)
               (value-of exp1 (init-env)))))

;; value-of : Exp * Env -> ExpVal
(define (value-of exp env)
  (cases expression exp

    (const-exp (num) (num-val num))

    (var-exp (var) (apply-env env var))

    (diff-exp (exp1 exp2)
              (display 'diff-exp)
              (newline)
              (display exp1)
              (newline)
              (display exp2)
              (newline)
              (let ((val1 (value-of exp1 env))
                    (val2 (value-of exp2 env)))
                (let ((num1 (expval->num val1))
                      (num2 (expval->num val2)))
                  (num-val (- num1 num2)))))
    (minus-exp (exp1)
               (let ((val (value-of exp1 env)))
                 (let ((num (expval->num val)))
                   (num-val (* -1 num)))))

    (add-exp (exp1 exp2)
             (let ((val1 (value-of exp1 env))
                   (val2 (value-of exp2 env)))
               (let ((num1 (expval->num val1))
                     (num2 (expval->num val2)))
                 (num-val (+ num1 num2)))))

    (div-exp (exp1 exp2)
             (let ((val1 (value-of exp1 env))
                   (val2 (value-of exp2 env)))
               (let ((num1 (expval->num val1))
                     (num2 (expval->num val2)))
                 (num-val (/ num1 num2)))))

    (mult-exp (exp1 exp2)
              (let ((val1 (value-of exp1 env))
                    (val2 (value-of exp2 env)))
                (let ((num1 (expval->num val1))
                      (num2 (expval->num val2)))
                  (num-val (* num1 num2)))))

    (zero?-exp (exp1)
               (let ((val1 (value-of exp1 env)))
                 (let ((num1 (expval->num val1)))
                   (if (zero? num1)
                       (bool-val #t)
                       (bool-val #f)))))

    (if-exp (exp1 exp2 exp3)
            (let ((val1 (value-of exp1 env)))
              (if (expval->bool val1)
                  (value-of exp2 env)
                  (value-of exp3 env))))

;     (let-exp (var exp1 body)
;              (let (
;                    [val1 (map (lambda (e) (append (value-of e env)))exp1)])
;                (display '111)
;                (newline)
;                    (let ([env1 (map (lambda (v va) (extend-env v va env)) var val1)])
;                      (value-of body (car env1)))))

    ; let var = exp1 in body
    ; (eval "let x = 3 y = 5 in -(x,1)")
    ; var = (x y)
    ; exp1 = (#(struct:const-exp 3) #(struct:const-exp 5))
    (let-exp (var exp1 body)
             (let
                 ([vals (map (lambda (e) (value-of e env))exp1)])
               (display 'The-next-two-lines-shows-var-and-exp1)
               (newline)
               (display var)
               (newline)
               (display exp1)
               (newline)
               (newline)
                   (let
                       ([env1 (map (lambda (variable value) (extend-env variable value env)) var vals)])
                     (value-of body (car env1)))))

    (letrec-exp (p-name param p-body letrec-body)
                (value-of letrec-body (extend-env-rec p-name
                                                      param
                                                      p-body
                                                      env)))

    (proc-exp (var body)
              (proc-val (procedure var body env)))

    (call-exp (rator rand)
              (let ((proc (expval->proc (value-of rator env)))
                    (arg (value-of rand env)))
                (apply-procedure proc arg)))


    ))

;; apply-procedure : Proc * ExpVal -> ExpVal
(define (apply-procedure proc1 val)
  (cases proc proc1
    (procedure (var body saved-env)
               (value-of body (extend-env var val saved-env)))))

;;;;;;   EVALUATION WRAPPERS

;; parse: String -> a-program
(define (parse p) (scan&parse p))

;; eval : String -> ExpVal
(define (eval string)
  (value-of-program (parse string)))

;;;;; EXAMPLES OF EVALUATION

;
;  (eval "+(1, 2)")
;  (eval "+(minus(1), +(minus(2), minus(0)))")
;  (eval "/(minus(1), 2)")
;  (eval "minus(1)")
;  (eval "minus(-1)")
;  (eval "if zero?(1) then 1 else 2")
;  (eval "-(x, v)")
;  (eval "if zero?(-(x, x)) then x else 2")
;  (eval "if zero?(-(x, v)) then x else 2")
;  (eval "let decr = proc (a) -(a, 1) in (decr 30)")
;  (eval "( proc (g) (g 30) proc (y) -(y, 1))")
;  (eval "let x = 200
;           in let f = proc (z) -(z, x)
;                in let x = 100
;                     in let g = proc (z) -(z, x)
;                          in -((f 1), (g 1))")
;  (eval "let x = 200
;           in let f = proc (z) -(z, x)
;                in let x = 100
;                     in let g = proc (z) -(z, x)
;                          in -((f 1), (g 1))")
;
;  (eval "letrec fact (n) = if zero?(n) then 1 else *(n, (fact -(n, 1))) in (fact 5)")
;