;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(planet plai/plai:1:5/lang/reader)
; based on PLAI Chap. 13
; Note that the interpreter is different than the BCFAE interpreter in the book
; in the book, function arguments are passed via the store. Here they
; are passed via the environment

(define-type BCFAE
  [num (n number?)]
  [add (lhs BCFAE?) (rhs BCFAE?)]
  [id (name symbol?)]
  [fun (param symbol?) (body BCFAE?)]
  [with (param symbol?) (named-expr BCFAE?) (body BCFAE?)]
  [app (fun-expr BCFAE?) (arg-expr BCFAE?)]
  [if0 (cond BCFAE?) (then BCFAE?) (else BCFAE?)]
  [newbox (content BCFAE?)]
  [setbox (bx BCFAE?) (ctnt BCFAE?)]
  [openbox (bx BCFAE?)]
  [seqn (fst BCFAE?) (snd BCFAE?)])

(define-type BCFAE-Value
  [numV (n number?)]
  [closureV (param symbol?) (body BCFAE?) (env Env?)]
  [boxV (location number?)])


(define-type Env
  [emptyEnv]
  [anEnv (name symbol?) (value BCFAE-Value?) (rest Env?)]) ;; Change 1

(define (env-lookup name env)
  (type-case Env env
             [emptyEnv () (error 'lookup "name not found")]
             [anEnv (n value rest)
                    (if (symbol=? n name)
                        value
                        (env-lookup name rest))]))

(define-type Store
  [emptyStore]
  [aStore (location number?)
          (value BCFAE-Value?)
          (store Store?)])

(define (store-lookup loc sto)
  (type-case Store sto
             [emptyStore () (error 'store-lookup "no value at location")]
             [aStore (location value rest-store)
                     (if (= location loc)
                         value
                         (store-lookup loc rest-store))]))

(define-type Value*Store
  [v*s (value BCFAE-Value?) (store Store?)])

(define next-location
  (local ([define last-loc (box 99)])
    (lambda (store)
      (begin
        (set-box! last-loc (+ 1 (unbox last-loc)))
        (unbox last-loc)))))

(define (interp expr env store)
  (type-case BCFAE expr
             [num (n) (v*s (numV n) store)]
             [add (l r) 
               (type-case Value*Store (interp l env store)
                 [v*s (l-value l-store)
                   (type-case Value*Store (interp r env l-store)
                      [v*s (r-value r-store)
                        (v*s (numV (+ (numV-n l-value) (numV-n r-value)))
                           r-store)])])]
             [id (v) (v*s (env-lookup v env) store)]  ;; change 2
             [fun (bound-id bound-body) (v*s (closureV bound-id bound-body env) store)]
             [with (param named-expr body)
                   (interp (app (fun param body) named-expr) env store)]
             [app (the-fun the-arg) 
               (type-case Value*Store (interp the-fun env store)
                  [v*s (fun-value fun-store)
                    (type-case Value*Store (interp the-arg env fun-store)
                       [v*s (arg-value arg-store)
                            (interp (closureV-body fun-value)
                                    (anEnv (closureV-param fun-value)
                                           arg-value ;; change 3
                                           (closureV-env fun-value))
                                    arg-store)])])]
             [if0 (test then else)
                  (type-case Value*Store (interp test env store)
                     [v*s (test-value test-store)
                         (if (zero? (numV-n test-value))
                             (interp then env test-store)
                             (interp else env test-store))])]
             [newbox (value-expr)
                     (type-case Value*Store (interp value-expr env store)
                         [v*s (expr-value expr-store)
                           (local ([define new-loc (next-location expr-store)])
                                 (v*s (boxV new-loc)
                                      (aStore new-loc expr-value expr-store)))])]
             [setbox (box-expr value-expr)
                  (type-case Value*Store (interp box-expr env store)
                      [v*s (box-value box-store)
                        (type-case Value*Store (interp value-expr env box-store)
                           [v*s (value-value value-store)
                               (v*s value-value
                                    (aStore (boxV-location box-value)
                                            value-value
                                            value-store))])])]
             [openbox (box-expr)
                      (type-case Value*Store (interp box-expr env store)
                                 [v*s (box-value box-store)
                                      (v*s (store-lookup (boxV-location box-value)
                                                         box-store)
                                           box-store)])]
             
             [seqn (e1 e2)
                   (type-case Value*Store (interp e1 env store)
                              [v*s (e1-value e1-store)
                                   (interp e2 env e1-store)])]))

(define (run p)
  (interp p (emptyEnv) (emptyStore)))
; Tests

(define test1
  (with 'switch (newbox (num 0))
        (with 'toggle (fun 'dum
                           (if0 (openbox (id 'switch))
                                (seqn 
                                 (setbox (id 'switch) (num 1))
                                 (num 1))
                                (seqn
                                 (setbox (id 'switch) (num 0))
                                 (num 0))))
              (add
               (app (id 'toggle) (num 1729))
               (app (id 'toggle) (num 1729))))))