;; 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:3/lang/reader)
(define-type RCFAE
  [num (n number?)]
  [add (lhs RCFAE?)
       (rhs RCFAE?)]
  [sub (lhs RCFAE?)
       (rhs RCFAE?)]
  [id (name symbol?)]
  [fun (param symbol?)
       (body RCFAE?)]
  [app (fun-expr RCFAE?)
       (arg-expr RCFAE?)]
  [if0 (test-expr RCFAE?)
       (then-expr RCFAE?)
       (else-expr RCFAE?)]
  [rec (name symbol?)
       (named-expr RCFAE?)
       (body RCFAE?)])

(define-type SubCache
  [mtSub]
  [aSub (name symbol?)
        (value RCFAE-Value?)
        (sc SubCache?)]
  [aRecSub (name symbol?)
           (value-box (box-of RCFAE-Value?))
           (sc SubCache?)])

(define-type RCFAE-Value
  [numV (n number?)]
  [closureV (param symbol?)
            (body RCFAE?)
            (sc SubCache?)])

(define (box-of pred)
  (lambda (x)
    (and (box? x) (pred (unbox x)))))

;; interp : RCFAE SubCache -> RCFAE-Value
(define (interp a-rcfae sc)
  (type-case RCFAE a-rcfae
    [num (n) (numV n)]
    [add (l r) (num+ (interp l sc) (interp r sc))]
    [sub (l r) (num- (interp l sc) (interp r sc))]
    [id (name) (lookup name sc)]
    [fun (param body-expr) 
         (closureV param body-expr sc)]
    [app (fun-expr arg-expr)
         (local [(define fun-val
                   (interp fun-expr sc))]
           (interp (closureV-body fun-val)
                   (aSub (closureV-param fun-val)
                         (interp arg-expr sc)
                         (closureV-sc fun-val))))]
    [if0 (test-expr then-expr else-expr)
         (if (numzero? (interp test-expr sc))
             (interp then-expr sc)
             (interp else-expr sc))]
    [rec (bound-id named-expr body-expr)
         (local [(define value-holder (box (numV 42)))
                 (define new-sc (aRecSub bound-id
                                         value-holder
                                         sc))]
           (begin
             (set-box! value-holder (interp named-expr new-sc))
             (interp body-expr new-sc)))]))

;; num-op : (number number -> number) -> (FAE-Value FAE-Value -> FAE-Value)
(define (num-op op op-name x y)
  (numV (op (numV-n x) (numV-n y))))

(define (num+ x y) (num-op + '+ x y))
(define (num- x y) (num-op - '- x y))

;; numzero? : RCFAE-Value -> boolean
(define (numzero? n)
  (zero? (numV-n n)))

(define (lookup name sc)
  (type-case SubCache sc
    [mtSub () (error 'lookup "free variable")]
    [aSub (sub-name val rest-sc)
          (if (symbol=? sub-name name)
              val
              (lookup name rest-sc))]
    [aRecSub (sub-name val-box rest-sc)
             (if (symbol=? sub-name name)
                 (unbox val-box)
                 (lookup name rest-sc))]))

(test (interp (num 10)
              (mtSub))
      (numV 10))
(test (interp (add (num 10) (num 7))
              (mtSub))
      (numV 17))
(test (interp (sub (num 10) (num 7))
              (mtSub))
      (numV 3))
(test (interp (app (fun 'x (add (id 'x) (num 12)))
                   (add (num 1) (num 17)))
              (mtSub))
      (numV 30))
(test (interp (id 'x)
              (aSub 'x (numV 10) (mtSub)))
      (numV 10))

(test (interp (app (fun 'x (add (id 'x) (num 12)))
                   (add (num 1) (num 17)))
              (mtSub))
      (numV 30))

(test (interp (app (fun 'x
                        (app (fun 'f
                                  (add (app (id 'f) (num 1))
                                       (app (fun 'x
                                                 (app (id 'f) (num 2)))
                                            (num 3))))
                             (fun 'y (add (id 'x) (id 'y)))))
                   (num 0))
              (mtSub))
      (numV 3))

(test/exn (interp (id 'x) (mtSub))
          "free variable")

(test (interp (app (fun 'x
                        (rec 'y (num 12)
                             (id 'x)))
                   (num 10))
              (mtSub))
      (numV 10))

;; (fib 5):
(test (interp (rec 'fib (fun 'n
                             (if0 (id 'n)
                                  (num 1)
                                  (if0 (sub (id 'n) (num 1))
                                       (num 1)
                                       (add (app (id 'fib)
                                                 (sub (id 'n) (num 1)))
                                            (app (id 'fib)
                                                 (sub (id 'n) (num 2)))))))
                   (app (id 'fib) (num 5)))
              (mtSub))
      (numV 8))