cont.ml

module Id = struct
  let (>>=) value callback =
    callback value

  let return x = x

  let get x = x
end

module Free = struct
  type a = int

  type 'a t =
    | Return : a -> a t
    | Bind : a t * (a -> a t) -> a t

(*   let (>>=) value callback = Bind (value, callback) *)

  let rec (>>=) value callback =
    match value with
    | Bind (value', callback') ->
        Bind (value', fun x -> callback' x >>= callback)
    | Return value' -> Bind (value, callback)

  let return x = Return x

  let rec get : a t -> a = function
    | Return value -> value
    | Bind (value, callback) -> get (callback (get value))

  let rec run : a t -> a = function
    | Return value -> assert false; value
    | Bind (free, callback) ->
        match free with
        | Return value -> run (callback value)
        | Bind (free', callback') ->
            run (free' >>= (fun x -> callback' x >>= callback))
(*
            run (
              Bind (free', fun x -> Bind (callback' x, callback))
            )
*)
end

open Free

let rec factorial = function
  | 0 -> return 1
  | n ->
      factorial (n - 1) >>= fun m ->
      return (n * m)

(*
let rec overflow1 = function
  | 0 -> 42
  | n ->
      1 + overflow1 (n - 1)
*)


let rec overflow = function
  | 0 -> return 42
  | n ->
      overflow (n - 2) >>= fun m ->
      (assert false;
      return (n + m))


let () = print_int (run (overflow 1000000))