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
open Stdune
module Fiber_inside_lwt = struct
let key = Fiber.Var.create ()
let run fiber =
let fills, push = Lwt_stream.create () in
let fiber = Fiber.Var.set key push (fun () -> fiber) in
let rec loop = function
| Fiber.Scheduler.Done x -> Lwt.return x
| Fiber.Scheduler.Stalled stalled ->
Lwt.bind (Lwt_stream.next fills) (fun fill ->
loop (Fiber.Scheduler.advance stalled [ fill ]))
in
loop (Fiber.Scheduler.start fiber)
let callback_to_lwt f =
Fiber.bind (Fiber.Var.get key) ~f:(function
| None ->
failwith "Fiber_lwt.Fiber_inside_lwt.run_lwt: called outside [run]"
| Some push_fill ->
let ivar = Fiber.Ivar.create () in
Lwt.async (fun () ->
Lwt.bind
(Lwt.try_bind f
(fun x -> Lwt.return (Ok x))
(fun exn -> Lwt.return (Error exn)))
(fun x ->
push_fill (Some (Fiber.Fill (ivar, x)));
Lwt.return_unit));
Fiber.Ivar.read ivar)
end