;; 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 KCFAE
  [num (n number?)]
  [add (lhs KCFAE?)
       (rhs KCFAE?)]
  [sub (lhs KCFAE?)
       (rhs KCFAE?)]
  [id (name symbol?)]
  [fun (param symbol?)
       (body KCFAE?)]
  [app (fun-expr KCFAE?)
       (arg-expr KCFAE?)]
  [if0 (test KCFAE?)
       (then KCFAE?)
       (else KCFAE?)]
  [withcc (name symbol?)
          (body KCFAE?)])

(define-type KCFAE-Value
  [numV (n number?)]
  [closureV (param symbol?)
            (body KCFAE?)
            (sc DefrdSub?)]
  [contV (proc procedure?)])

(define-type DefrdSub
  [mtSub]
  [aSub (name symbol?)
        (value KCFAE-Value?)
        (rest DefrdSub?)])

;; ----------------------------------------

;; parse : S-expr -> KCFAE
(define (parse sexp)
  (cond
    [(number? sexp) (num sexp)]
    [(symbol? sexp) (id sexp)]
    [(pair? sexp)
     (case (car sexp)
       [(+) (add (parse (second sexp)) (parse (third sexp)))]
       [(-) (sub (parse (second sexp)) (parse (third sexp)))]
       [(fun) (fun (first (second sexp)) (parse (third sexp)))]
       [(if0) (if0 (parse (second sexp))
                   (parse (third sexp))
                   (parse (fourth sexp)))]
       [(withcc) (withcc (second sexp) (parse (third sexp)))]
       [else (app (parse (first sexp)) (parse (second sexp)))])]))

(test (parse 3) (num 3))
(test (parse 'x) (id 'x))
(test (parse '{+ 1 2}) (add (num 1) (num 2)))
(test (parse '{- 1 2}) (sub (num 1) (num 2)))
(test (parse '{fun {x} x}) (fun 'x (id 'x)))
(test (parse '{1 2}) (app (num 1) (num 2)))
(test (parse '{if0 0 1 2}) (if0 (num 0) (num 1) (num 2)))
(test (parse '{withcc x 2}) (withcc 'x (num 2)))

;; ----------------------------------------

;; interp : KCFAE DefrdSub (KCFAE-Value -> alpha) -> alpha
(define (interp a-fae ds k)
  (type-case KCFAE a-fae
    [num (n) (k (numV n))]
    [add (l r) (interp l ds
                       (lambda (v1)
                         (interp r ds
                                 (lambda (v2)
                                   (k (num+ v1 v2))))))]
    [sub (l r) (interp l ds
                       (lambda (v1)
                         (interp r ds
                                 (lambda (v2)
                                   (k (num- v1 v2))))))]
    [id (name) (k (lookup name ds))]
    [fun (param body-expr)
         (k (closureV param body-expr ds))]
    [app (fun-expr arg-expr)
         (interp fun-expr ds
                 (lambda (fun-val)
                   (interp arg-expr ds
                           (lambda (arg-val)
                             (type-case KCFAE-Value fun-val
                               [closureV (param body ds)
                                         (interp body
                                                 (aSub param
                                                       arg-val
                                                       ds)
                                                 k)]
                               [contV (k)
                                      (k arg-val)]
                               [else (error 'interp "not a function")])))))]
    [if0 (test-expr then-expr else-expr)
         (interp test-expr ds
                 (lambda (v)
                   (if (numzero? v)
                       (interp then-expr ds k)
                       (interp else-expr ds k))))]
    [withcc (id body-expr)
            (interp body-expr 
                    (aSub id
                          (contV k)
                          ds)
                    k)]))

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

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

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

(define (lookup name ds)
  (type-case DefrdSub ds
    [mtSub () (error 'lookup "free variable")]
    [aSub (sub-name num rest-sc)
          (if (symbol=? sub-name name)
              num
              (lookup name rest-sc))]))

(test/exn (lookup 'x (mtSub)) "free variable")
(test (lookup 'x (aSub 'x (numV 9) (mtSub))) (numV 9))
(test (lookup 'x (aSub 'y (numV 10) (aSub 'x (numV 9) (mtSub)))) (numV 9))

;; interp-expr : KCFAE -> KCFAE-Value
(define (interp-expr a-fae)
  (type-case KCFAE-Value (interp a-fae (mtSub) (lambda (x) x))
    [numV (n) n]
    [closureV (param body ds) 'function]
    [contV (k) 'function]))

(test (interp-expr (parse 10))
      10)
(test (interp-expr (parse '{fun {x} x}))
      'function)
(test (interp-expr (parse '{withcc x x}))
      'function)

(test (interp-expr (parse '{+ 10 7}))
      17)
(test (interp-expr (parse '{- 10 7}))
      3)
(test (interp-expr (parse '{{fun {x} {+ x 12}}
                            {+ 1 17}}))
      30)

(test (interp-expr (parse'{{fun {x} {{fun {f} {+ {f 1}
                                                 {{fun {x} {f 2}}
                                                  3}}}
                                     {fun {y} {+ x y}}}}
                           0}))
      3)

(test (interp-expr (parse '{withcc k {k 10}}))
      10)

(test (interp-expr (parse '{withcc k
                                   {+ {k 10}
                                      17}}))
      10)

(test (interp-expr
       (parse
        '{{fun {mk-list}
               {{fun {list}
                     ; list has 2 numbers and k;
                     ; is first zero? 
                     {if0 {list 0}
                          ; return second:
                          {list 1} 
                          ; else recur...
                          {0 ; <- never actually applied!
                           ; recur by jumping to k:
                           {{list 2} {{{mk-list 
                                        {- {list 0} 1}} ; -1 to first
                                       {+ {list 1} 2}} ; +2 to second
                                      {list 2}}}}}} ; keep k as third
                {withcc k
                        ; make list with 2 numbers and k
                        {{{mk-list 3} 0} k}}}}                 
          ; mk-list - represent a list pf 3 items as a function, where
          ;  the function argument is a selector
          {fun {a}
               {fun {b}
                    {fun {c}
                         {fun {sel}
                              {if0 sel
                                   a
                                   {if0 {- sel 1}
                                        b
                                        c}}}}}}}))
      6)

;; Check for eager evaluation:
(test/exn (interp-expr (parse '{{fun {x} 0}
                                {1 {fun {y} y}}}))
          "not a function")