(* This is the type of commands passed to the manager. *)
type 'a shift = ('a cont -> 'a action)
and 'a cont = (unit -> 'a action) -> 'a action
and 'a action =
    Return of 'a
  | Shift of (int * 'a shift * 'a cont)
;;

exception Bug
let returned = function Return y -> y | _ -> raise Bug;;

type 'a prompt = 'a action Cupto.prompt;;
let compose set k' k x = k' (fun () -> set (fun () -> k x)) ;;
let rec set_control control p a =
  let comp = compose (set_control control p) in
  match Cupto.set control a with
    Shift (q, a, k) ->
      if q >= p then a k
      else (Cupto.cupto control (fun k'-> Shift (q, a, comp k' k)) ())
  | x -> x ;;

let cupto_control control p a =
  let a' k' k = a (compose (set_control control p) k k') in
  Cupto.cupto control
    (fun k' -> Shift (p, a' k', fun x -> x())) ;;

let reset control p a =
  returned (set_control control p (fun () -> Return (a()))) ;;
let shift control p a =
  cupto_control control p (fun k ->
    (* we must reset captured prompt ---and control *)
    set_control control p (fun () -> Return (a (fun x -> returned (k x)))))
;;
let eval a =
  let c = Cupto.new_prompt () in
  reset c 0 (fun () -> a c);;