simon/moonpool
1
0
Fork 0
mirror of https://github.com/c-cube/moonpool.git synced 2025-12-06 03:05:30 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

add Fiber.spawn_top_or_link

Browse source
This commit is contained in:
Simon Cruanes 2024-02-29 15:07:40 -05:00
parent 39cdc37613
commit 7b5ecffc8c
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 23 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/fib/fiber.ml
View file

@ -194,16 +194,23 @@ let[@inline] self () : any =
| None -> failwith "Fiber.self: must be run from inside a fiber." | None -> failwith "Fiber.self: must be run from inside a fiber."
| Some f -> f | Some f -> f
let spawn_link ~protect f : _ t = let spawn_link_ ?(protect = true) parent f : _ t =
match Task_local_storage.get k_current_fiber with
| None -> failwith "Fiber.spawn_link: must be run from inside a fiber."
| Some (Any parent) ->
(* spawn [f()] with a copy of our local storage *) (* spawn [f()] with a copy of our local storage *)
let ls = Task_local_storage.Private_.Storage.copy_of_current () in let ls = Task_local_storage.Private_.Storage.copy_of_current () in
let child = spawn_ ~ls:(Some ls) ~on:parent.runner f in let child = spawn_ ~ls:(Some ls) ~on:parent.runner f in
add_child_ ~protect parent child; add_child_ ~protect parent child;
child child
let spawn_link ?protect f : _ t =
match Task_local_storage.get k_current_fiber with
| None -> failwith "Fiber.spawn_link: must be run from inside a fiber."
| Some (Any parent) -> spawn_link_ ?protect parent f
let spawn_top_or_link ?protect ~on f : _ t =
match Task_local_storage.get k_current_fiber with
| None -> spawn_top ~on f
| Some (Any parent) -> spawn_link_ ?protect parent f
type cancel_handle = int type cancel_handle = int
let add_on_cancel (self : _ t) cb : cancel_handle = let add_on_cancel (self : _ t) cb : cancel_handle =

11
src/fib/fiber.mli
View file

@ -112,7 +112,7 @@ val spawn_top : on:Runner.t -> (unit -> 'a) -> 'a t
This fiber is not the child of any other fiber: its lifetime This fiber is not the child of any other fiber: its lifetime
is only determined by the lifetime of [f()]. *) is only determined by the lifetime of [f()]. *)
val spawn_link : protect:bool -> (unit -> 'a) -> 'a t val spawn_link : ?protect:bool -> (unit -> 'a) -> 'a t
(** [spawn_link ~protect f] spawns a sub-fiber [f_child] (** [spawn_link ~protect f] spawns a sub-fiber [f_child]
from a running fiber [parent]. from a running fiber [parent].
The sub-fiber [f_child] is attached to the current fiber and fails The sub-fiber [f_child] is attached to the current fiber and fails
@ -121,7 +121,14 @@ val spawn_link : protect:bool -> (unit -> 'a) -> 'a t
@param protect if true, when [f_child] fails, it does not @param protect if true, when [f_child] fails, it does not
affect [parent]. If false, [f_child] failing also affect [parent]. If false, [f_child] failing also
causes [parent] to fail (and therefore all other children causes [parent] to fail (and therefore all other children
of [parent]). of [parent]). Default is [true].
Must be run from inside a fiber. Must be run from inside a fiber.
@raise Failure if not run from inside a fiber. *) @raise Failure if not run from inside a fiber. *)
val spawn_top_or_link : ?protect:bool -> on:Runner.t -> (unit -> 'a) -> 'a t
(** [spawn_top_or_link ~on ~protect f] runs [f()] in a new fiber.
If this is run from inside a fiber, this behaves like [spawn_link ~protect f]
(links to the parent); otherwise it behaves like [spawn_top ~on f].
@param protect if false, failure of the new fiber will also cancel
the parent (in case there is a parent). Default [true]. See {!spawn_link}. *)