;; 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:6/lang/reader)
; Lecture Notes 
; Programming Languages and Types
; 
; October 28, 2009
; Instructor: Tillmann Rendel

; Use this file with DrScheme and the PLAI language level

; Based on PLAI by Shriram Krishnamurthi 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Consider this FAE expression. What happens if it is evaluated?

;  {with {sum {fun {n}
;               {if0 n
;                    0
;                    {add n {sum {add n -1}}}}}}
;    {sum 100}}

; Let's add a "with" that allows recursion. We call it "rec".


(define-type RCFAE
  [num (n number?)]
  [add (lhs RCFAE?) (rhs RCFAE?)]
  [id (name symbol?)]
  [fun (param symbol?) (body RCFAE?)]
  [app (fun-expr RCFAE?) (arg-expr RCFAE?)]
  [if0 (cond RCFAE?) (then RCFAE?) (else RCFAE?)]
  [rec-fun (bound-id symbol?) (param symbol?) (fun-body RCFAE?) (body RCFAE?)])


  
; Example


(define test1 (rec-fun 'sum 'n 
                          (if0 (id 'n) 
                               (num 0) 
                               (add (id 'n) (app (id 'sum) (add (id 'n) (num -1)))))
                (app (id 'sum) (num 100))))


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


(define-type Env
  [emptyEnv]
  [anEnv (name symbol?) (value RCFAE-Value?) (rest Env?)]
  [recEnv (name symbol?) (value boxed-RCFAE-Value?) (rest Env?)])

(define (boxed-RCFAE-Value? v)
  (and (box? v)
       (or (RCFAE-Value? (unbox v))
           (boolean? (unbox v)))))

(define (lookup name env)
  (type-case Env env
             [emptyEnv () (error 'lookup (string-append "name not found: " (symbol->string name)))]
             [anEnv (n value rest)
                    (if (symbol=? n name)
                        value
                        (lookup name rest))]
             [recEnv (n value rest)
                    (if (symbol=? n name)
                        (if (unbox value)
                            (unbox value)
                            (error 'lookup "cyclic definition"))
                        (lookup name rest))]))


; Let's define the interpreter

(define (interp expr env)
  (type-case RCFAE expr
             [num (n) (numV n)]
             [add (l r) (numV (+ (numV-n (interp l env)) (numV-n (interp r env))))]
             [id (v) (lookup v env)]
             [fun (bound-id bound-body) 
                  (closureV bound-id bound-body env)]
             [app (the-fun the-arg) 
                  (let ((fun-val (interp the-fun env)))
                    (interp (closureV-body fun-val)
                            (anEnv (closureV-param fun-val)
                                   (interp the-arg env)
                                   (closureV-env fun-val))))]
             [if0 (cond then else)
                  (if (zero? (numV-n (interp cond env)))
                      (interp then env)
                      (interp else env))]
             [rec-fun (bound-id param fun-body body)
                (let* ((placeholder (box false))
                       (cyclic-env (recEnv bound-id placeholder env))
                       (named-value (closureV param fun-body cyclic-env)))
                  (set-box! placeholder named-value)
                  (interp body cyclic-env))]))



(define (interp-cps expr env)
  (interp (app expr (fun 'x (id 'x))) env))


(define (cps exp)
  )


; Tests

(test (interp-cps (cps test1) (emptyEnv)) (interp test1 (emptyEnv)))