mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-12 22:10:46 -05:00
refactor: move some common code to Suspend_
This commit is contained in:
parent
4c4b720306
commit
0cec78eb30
2 changed files with 24 additions and 0 deletions
|
|
@ -1,3 +1,5 @@
|
||||||
|
module A = Atomic_
|
||||||
|
|
||||||
type suspension = (unit, exn * Printexc.raw_backtrace) result -> unit
|
type suspension = (unit, exn * Printexc.raw_backtrace) result -> unit
|
||||||
type task = unit -> unit
|
type task = unit -> unit
|
||||||
|
|
||||||
|
|
@ -32,9 +34,28 @@ let with_suspend ~(run : with_handler:bool -> task -> unit) (f : unit -> unit) :
|
||||||
|
|
||||||
E.try_with f () { E.effc }
|
E.try_with f () { E.effc }
|
||||||
|
|
||||||
|
(* DLA interop *)
|
||||||
|
let prepare_for_await () : Dla_.t =
|
||||||
|
(* current state *)
|
||||||
|
let st : ((with_handler:bool -> task -> unit) * suspension) option A.t =
|
||||||
|
A.make None
|
||||||
|
in
|
||||||
|
|
||||||
|
let release () : unit =
|
||||||
|
match A.exchange st None with
|
||||||
|
| None -> ()
|
||||||
|
| Some (run, k) -> run ~with_handler:true (fun () -> k (Ok ()))
|
||||||
|
and await () : unit =
|
||||||
|
suspend { handle = (fun ~run k -> A.set st (Some (run, k))) }
|
||||||
|
in
|
||||||
|
|
||||||
|
let t = { Dla_.release; await } in
|
||||||
|
t
|
||||||
|
|
||||||
[@@@ocaml.alert "+unstable"]
|
[@@@ocaml.alert "+unstable"]
|
||||||
[@@@else_]
|
[@@@else_]
|
||||||
|
|
||||||
let with_suspend ~run:_ f = f ()
|
let with_suspend ~run:_ f = f ()
|
||||||
|
let prepare_for_await () = { Dla_.release = ignore; await = ignore }
|
||||||
|
|
||||||
[@@@endif]
|
[@@@endif]
|
||||||
|
|
|
||||||
|
|
@ -50,6 +50,9 @@ val suspend : suspension_handler -> unit
|
||||||
|
|
||||||
[@@@endif]
|
[@@@endif]
|
||||||
|
|
||||||
|
val prepare_for_await : unit -> Dla_.t
|
||||||
|
(** Our stub for DLA. Unstable. *)
|
||||||
|
|
||||||
val with_suspend :
|
val with_suspend :
|
||||||
run:(with_handler:bool -> task -> unit) -> (unit -> unit) -> unit
|
run:(with_handler:bool -> task -> unit) -> (unit -> unit) -> unit
|
||||||
(** [with_suspend ~run f] runs [f()] in an environment where [suspend]
|
(** [with_suspend ~run f] runs [f()] in an environment where [suspend]
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue