diff --git a/src/fib/main.ml b/src/fib/main.ml new file mode 100644 index 00000000..26112015 --- /dev/null +++ b/src/fib/main.ml @@ -0,0 +1,16 @@ +exception Oh_no of Exn_bt.t + +let main (f : Runner.t -> 'a) : 'a = + let st = Fifo_pool.Private_.create_state ~threads:[| Thread.self () |] () in + let runner = Fifo_pool.Private_.runner_of_state st in + try + let fiber = Fiber.spawn_top ~on:runner (fun () -> f runner) in + Fiber.on_result fiber (fun _ -> Runner.shutdown_without_waiting runner); + (* run the main thread *) + Fifo_pool.Private_.run_thread st runner ~on_exn:(fun e bt -> + raise (Oh_no (Exn_bt.make e bt))); + match Fiber.peek fiber with + | Some (Ok x) -> x + | Some (Error ebt) -> Exn_bt.raise ebt + | None -> assert false + with Oh_no ebt -> Exn_bt.raise ebt diff --git a/src/fib/main.mli b/src/fib/main.mli new file mode 100644 index 00000000..8d3fa8a9 --- /dev/null +++ b/src/fib/main.mli @@ -0,0 +1,25 @@ +(** Main thread. + + This is evolved from [Moonpool.Immediate_runner], but unlike it, + this API assumes you run it in a thread (possibly + the main thread) which will block until the initial computation is done. + + This means it's reasonable to use [Main.main (fun () -> do_everything)] + at the beginning of the program. + Other Moonpool pools can be created for background tasks, etc. to do the + heavy lifting, and the main thread (inside this immediate runner) can coordinate + tasks via [Fiber.await]. + + Aside from the fact that this blocks the caller thread, it is fairly similar to + {!Background_thread} in that there's a single worker to process + tasks/fibers. + + This handles effects, including the ones in {!Fiber}. + + @since NEXT_RELEASE +*) + +val main : (Moonpool.Runner.t -> 'a) -> 'a +(** [main f] runs [f()] in a scope that handles effects, including {!Fiber.await}. + + This scope can run background tasks as well, in a cooperative fashion. *) diff --git a/src/fib/moonpool_fib.ml b/src/fib/moonpool_fib.ml index e8063d1f..7804cc79 100644 --- a/src/fib/moonpool_fib.ml +++ b/src/fib/moonpool_fib.ml @@ -3,4 +3,7 @@ module Fiber = Fiber module Fls = Fls module Handle = Handle +module Main = Main include Fiber + +let main = Main.main