(* K Machine in cbv *)
(* 15-814, Fall 2021, Frank Pfenning *)
(* live coded *)

type E = $E. ('lam : E -> E) + ('app : E * E)
             + ('l : E) + ('r : E) + ('cases : E * (E -> E) * (E -> E))

decl I : E
decl K : E
decl K' : E
defn I = fold 'lam (\x. x)
defn K = fold 'lam (\x. fold 'lam (\y. x))
defn K' = fold 'lam (\x. fold 'lam (\y. y))

decl bottom : E
defn bottom = $f. f

decl eval_ : E -> (E -> E) -> E

defn eval_ = $eval_. \e. \k.
               case (unfold e)
                 of ( 'lam f => k e
                    | 'app (e1,e2) =>
                         eval_ e1 (\v1. eval_ e2 (\v2.
                           case (unfold v1) of ( 'lam f => eval_ (f v2) k )))
                    | 'l e => eval_ e (\v. k (fold 'l v))
                    | 'r e => eval_ e (\v. k (fold 'r v))
                    | 'cases (e0, bl, br) =>
                      eval_ e0 (\v0. case (unfold v0)
                                       of ('l v => eval_ (bl v) k
                                          |'r v => eval_ (br v) k)))

eval I' = eval_ (fold 'app (K',K)) (\v. v)