CEK

gistfile1.ml

type k =
  | Top
  | AddR of env * exp * k
  | AddL of int * k
  | AppR of env * exp * k
  | AppL of env * id * exp * k

let step (e : exp) (env : env) (k : k) : exp * env * k = match (e, k) with
  | Add (e1, e2), _ -> e1, env, AddR (env, e2, k)
  | Int n, AddR (env', e2, k') -> e2, env', AddL (n, k')
  | Int m, AddL (n, k') -> Int (m + n), env, k'
  | App (e1, e2), _ -> e1, env, AppR (env, e2, k)
  | Fun (x, body), AppR (env', e2, k') -> e2, env', AppL (env, x, body, k')
  | v, AppL (env', x, body, k') when is_value v ->
      body, bind x (v, env) env', k'
  | Id x, k -> 
    let (v, env') = lookup x env in
    v, env', k

let rec run (e : exp) (env : env) (k : k) = match (e, k) with
  | v, Top when is_value v -> v
  | e, k -> let (e', env', k') = step e env k in run e' env' k'

let run' e = run e Env.empty Top

let _let s e1 e2 =
  let x = Identifier.fresh s in
  App (Fun (x, e2 (Id x)), e1)

let _fun e =
  let x = Identifier.fresh "x" in
  Fun (x, e (Id x))

TEST "make_adder" =
  let exp = 
    _let "adder" (_fun (fun y -> _fun (fun x -> Add (x, y))))
      (fun adder ->
         _let "add_thirty" (App (adder, Int 30))
           (fun add_thirty ->
              _let "add_two" (App (adder, Int 2))
                (fun add_two ->
                   Add (App (add_thirty, Int 40), App (add_two, Int 3))))) in
  run' exp = Int 75