Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 9a656baf7b
Fetching contributors…

Cannot retrieve contributors at this time

file 39 lines (35 sloc) 0.94 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
let active_prompt = ref None

let start f =
  let t, u = Lwt.wait () in
  let p = Delimcc.new_prompt () in
  active_prompt := Some p;

  Delimcc.push_prompt p begin fun () ->
    let r =
      try Lwt.Return (f ())
      with e -> Lwt.Fail e in
    active_prompt := None;
    match r with
      | Lwt.Return v -> Lwt.wakeup u v
      | Lwt.Fail e -> Lwt.wakeup_exn u e
      | Lwt.Sleep -> assert false
  end;
  t

let await t =
  let p =
    match !active_prompt with
      | None -> failwith "await called outside start"
      | Some p -> p in

  match Lwt.poll t with
    | Some v -> v
    | None ->
        active_prompt := None;
        Delimcc.shift0 p begin fun k ->
          let ready _ =
            active_prompt := Some p;
            k ();
            Lwt.return () in
          ignore (Lwt.try_bind (fun () -> t) ready ready)
        end;
        match Lwt.poll t with
          | Some v -> v
          | None -> assert false
Something went wrong with that request. Please try again.