;;;; The values datatype

(define-datatype expval expval?
  (num-val (value number?)))
 
(define (expval->num v)
  (cases expval v
    (num-val (n) n)))

(define (diff-val v1 v2)
  (num-val (- (expval->num v1) (expval->num v2))))
 
(define (sum-val v1 v2)
  (num-val (+ (expval->num v1) (expval->num v2))))

(define (nonzero v)
  (not (zero? (expval->num v))))

;;;; Parser and scanner

(define scanner-spec-1
  '((white-sp (whitespace) skip)
    (comment ("//" (arbno (not #\newline))) skip)
    (identifier (letter (arbno (or letter digit))) symbol)
    (number (digit (arbno digit)) number)))

(define grammar-1
  '((stmt (identifier "=" exp ";") assign-stmt)
    (stmt ("{" stmtseq "}") compound-stmt) 
    (stmt ("if" exp "then" stmt "else" stmt) ite-stmt)
    (stmt ("while" exp "do" stmt ) while-stmt)
    (stmt ("var" "{" identifier "=" exp "}" "in" stmt) dec-stmt)
    (stmt ("print" "(" exp ")" ";") print-stmt) 
    (stmtseq (stmt stmtseq) nonempty-stmtseq)
    (stmtseq () empty-stmtseq)
    (exp (number) number-exp)
    (exp (identifier) var-exp)
    (exp ("-" "(" exp "," exp ")") diff-exp)
    (exp ("+" "(" exp "," exp ")") sum-exp)
    ;;;;;;;;;;;; PROBLEM 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (stmt ("INT" "{" identifier "(" (arbno identifier) ")" stmt "}" "in" stmt) int-proc)
    (stmt ("VOID" "{" identifier "(" (arbno identifier) ")" stmt "}" "in" stmt) void-proc)
    (stmt ("return" identifier ";") return-stmt)
    (stmt {"cmd:" exp ";"} call-stmt)
    (exp  ("run:" identifier "(" (arbno exp) ")") proc-exp)
    ;;;;;;;;;;;;;; PROBLEM 4 ;;;;;;;;;;;;;;;;;;;;;;;;
    (stmt ("array" "{" identifier "= declare[" number "] } in" stmt) array-stmt)
    (stmt ("array-set" identifier "[" exp "]" "=" exp ";") set-stmt)
    (exp ("array-val" identifier "[" exp "]") lookup-exp)
    ))

(sllgen:make-define-datatypes scanner-spec-1 grammar-1)

(define scan&parse
  (sllgen:make-string-parser scanner-spec-1 grammar-1))



;;;; Environments

(define empty-env (lambda () (eopl:error 'empty-env "Searching empty environment")))
  
(define extend-env
  (lambda (var val env)
    (lambda (s) (if (eqv? var s) val (apply-env env s)))))

(define apply-env (lambda (env s) (env s)))

;;;; Store: a totally naive list model

(define the-store 'uninit)

(define (initialize-store!) (set! the-store '()))

(define (newref! val)
    (let ([next-ref (length the-store)])
      (set! the-store (append the-store (list val)))
      next-ref))

(define (deref ref) (list-ref the-store ref))

(define (setref! ref val)
    (set! the-store 
          (letrec ([setref-inner
             ;; returns list like store1, except position ref 
             ;; contains val
                    (lambda (store1 ref1)
                      (cond [(null? store1) (eopl:error 'setref "Null pointer dereference")]
                            [(zero? ref1) (cons val (cdr store1))]
                            [else (cons (car store1) (setref-inner (cdr store1) (- ref1 1)))]))])
            (setref-inner the-store ref))))
                     
;;;; Evaluating expressions

(define Returner (num-val 0))

(define (value-of e env)
  (cases exp e
    (number-exp (n) (num-val n))
    (var-exp (v) (deref (apply-env env v)))
    (sum-exp (e1 e2) (sum-val (value-of e1 env) 
                              (value-of e2 env)))
    (diff-exp (e1 e2) (diff-val (value-of e1 env) 
                                (value-of e2 env)))
    (proc-exp (id e1) (value_compute (value-of (var-exp id) env) e1 env)
                       Returner)
    (lookup-exp (parameter index) (array_compute (value-of (var-exp parameter) env) index env) )))

(define (value_compute build e env)
  (define parameter (car build))
  (define body (car (cdr build)))
  (if (null? e)
      (result-of body env)
                (result-of body (extend-env (car parameter) (newref! (value-of (car e) env)) env))))

(define (array_compute vec index environment) 
  (if (> (expval->num (value-of index environment)) (vector-length vec)) 
      (brk_stmt) 
      (let ([val (vector-ref  vec (expval->num (value-of index environment)))])
        (if (expval? val)
            val
            (num-val val)))))

(define (brk_stmt)
  (display "ERROR: Out of bounds array reference.")
  )

;;;; Executing statements

(define (print-exp e env)
  (display "Print statement: ") (display (expval->num (value-of e env))) (display "\n"))

(define (result-of s env)
  (cases stmt s
    (assign-stmt (id e) 
                 (setref! (apply-env env id) (value-of e env)))
    (while-stmt (e s1) 
                (cond [(nonzero (value-of e env))
                       (result-of s1 env) (result-of s env)]
                       [else ()]))
    (dec-stmt (id e body)
              (let ([val (value-of e env)])
                (result-of body (extend-env id (newref! val) env))))
    (ite-stmt (e s1 s2) 
              (if (nonzero (value-of e env)) 
                  (result-of s1 env)
                  (result-of s2 env)))
    (compound-stmt (slst) 
                   (cases stmtseq slst
                     (empty-stmtseq () ())
                     (nonempty-stmtseq (s rest)
                                       (result-of s env)
                                       (result-of 
                                        (compound-stmt rest) env))))
    (print-stmt (e) (print-exp e env))
    (return-stmt (id) (set! Returner (value-of (var-exp id) env)))
    (void-proc (method parameter body computation) 
               (result-of computation (extend-env method (newref! (list parameter body)) env)))
    (int-proc (method parameter body computation) 
              (result-of computation (extend-env method (newref! (list parameter body)) env)) )
    (call-stmt (exp) (value-of exp env)) 
    (array-stmt (parameter size computation) 
                (result-of computation (extend-env parameter (newref! (make-vector size 0)) env)))
    (set-stmt (parameter index exp)
               (let ([temp (value-of (var-exp parameter) env)]) 
                        (vector-set! temp (expval->num (value-of index env)) (value-of exp env)) 
                        (deref (apply-env env parameter))
                        (newref! temp))))
  )

;;;; Drumroll... the interpreter!

(define (interpreter stmt)
  (initialize-store!)
  (result-of stmt empty-env))
    
;;;; Now testing!


(define 2a (scan&parse "{ var {x = 10} in var {x = x } in x = -(x, 10); print(x); }"))
(define 2b (scan&parse "var {x = 10} in var {x = x } in { x = -(x,10); print(x); }"))
(define 2c (scan&parse "var {x = 10} in var {y = x } in { x = -(y,10); print(x); }"))
(define 3a (scan&parse "var { y = 5 } in INT { bar(x) { x = 10; return x; } } in { y = run: bar(3); print(y); }")) 
(define 3b (scan&parse "var { y = 5 } in INT { bar(x) {return x; } } in { y = run: bar(3); print(y); }")) 
(define 3c (scan&parse "{ VOID { foo (x) {print(x);}} in cmd: run: foo(19);}"))
(define 3d (scan&parse "{ VOID { foo () {print(4);}} in cmd: run: foo();}"))
(define 3e (scan&parse "var { y = 11 } in INT { bar(x) { x = 754; return x; } } in if y then { y = run: bar(32); print(y); } else print(y);"))
(define 3ex1 (scan&parse "var { y = 3 } in INT { bar (y) {return y;}} in VOID {foo (x) {print(x);}} in cmd: run: foo( run: bar(11) );"))
(define 3ex2 (scan&parse "var { y = 8 } in INT { bar(x) { x = 22; return x; } } in VOID {foo (y) { print(y);}} in if y then { y = run: bar(1430); print(y); } else cmd: run: foo(run: bar(2340));"))
(define 3ex3 (scan&parse "var { y = 0 } in VOID { bar() {print(10);} } in VOID {foo (y) { var {z =5 } in y = +(z,y);print(y);}} in if y then { y = run: bar(10); print(y); } else cmd: run: foo( run: bar());"))
(define 4a (scan&parse "array { x = declare[5] } in print(array-val x[3]);"))
(define 4b (scan&parse "array { x = declare[5] } in { array-set x[2]=999; print(array-val x[2]);}"))
(define 4c (scan&parse "array { x = declare[5] } in { array-set x[2]=999; print(array-val x[15]);}"))

;;; EXAMPLE FUNCTION ;;;
(define (main)
;  (interpreter 2a)
   (display "PROBLEM 2: \n")
   (interpreter 2b)
   (interpreter 2c)
  (display "\n PROBLEM 3: \n")
   (interpreter 3a)
   (interpreter 3b)
   (interpreter 3c)
   (interpreter 3d)
   (interpreter 3e)
  (display "\n EXTRA CREDIT 3: \n")
   (interpreter 3ex1)
   (interpreter 3ex2)
   (interpreter 3ex3)
   (display "\n PROBLEM 4: \n")
   (interpreter 4a)
   (interpreter 4b)
   (interpreter 4c)
  )