(* AST *)
type expr =
  | EVar of var
  | EInt of int
  | EBool of bool
  | EIf of expr * expr * expr
  | EFun of var * expr
  | EApp of expr * expr
 and var = string


type value1 = 
  | VInt of int
  | VBool of bool
  | VFun of (value1 -> value1)
 and env1 = (var * value1) list

let rec eval1 : expr -> env1 -> value1 =
  fun e r ->
  match e with
  | EVar x -> List.assoc x r
  | EInt i -> VInt i
  | EBool b -> VBool b
  | EIf (e1, e2, e3) ->
     let VBool b = eval1 e1 r in
     if b then eval1 e2 r else eval1 e3 r
  | EFun (x, e) ->
     fun v -> eval1 e ((x,v)::r)
  | EApp (e1, e2) ->
     (let Fun f = eval1 e1 r in f) (eval1 e2 r)

(*
 apply : value -> value -> value = 
  fun f v ->
  let VClose (e, x, r) = f in
  eval e ((x, v)::r)
 *)

(* The simplest compiler *)
let compile0 : expr -> env -> value =
  fun e -> fun r -> eval e r

(* Less simple compiler that eliminates syntax analysis from run-time *)
let rec compile1 : expr -> env -> value =
  fun e -> (* compile time *)
  match e with
  | EVar x -> fun r -> List.assoc x r
  | EInt i -> fun r -> VInt i
  | EBool b -> fun r -> VBool b
  | EIf (e1, e2, e3) ->
     let c1 = compile1 e1 in
     let c2 = compile1 e2 in
     let c3 = compile1 e3 in
     fun r ->
     let VBool b = c1 r in
     if b then c2 r else c3 r
  | EFun (x, e) ->
     let c = compile1 e in
     fun r ->     
     VFun (fun v -> c ((x,v)::r))
  | EApp (e1, e2) ->
     let c1 = compile1 e1 in
     let c2 = compile1 e2 in
     fun r ->
     (let VFun f = c1 r in f) (c2 r)
 

(* Simple, not tail recursive factorial *)
let rec fact : int -> int =
  fun n ->
  if n = 0 then 1 else
    n * (fact (n-1))

(* Tail recursive in continuation passing style *)

let fact1 : int -> int = 
  let fact_cps : int -> (int -> int) -> int =
    fun n k ->
    if n = 0 then k 1 else
      fact_cps (n-1) (fun fn_1 -> k (n * fn_1))
  in
  fun n ->
  fact_cps n (fun fn -> fn)

(* Defunctionalized version of above *)

type stack = F0 of stack * int
	   | F1
let fact2 : int -> int =  
  let rec app : stack -> int -> int =
    fun k n ->
    match k with
    | F1 -> n
    | F0 (k, fn_1) -> app k (n * fn_1)
  and fact_stack : int -> stack -> int =
    fun n k ->
    if n = 0 then app k 1 else
      fact_stack (n-1) (F0 (k, n))
  in
  fun n -> fact_stack n F1


let x = (fun n -> n);;