add Fiber.spawn_top_or_link

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

View file

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

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
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]
from a running fiber [parent].
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
affect [parent]. If false, [f_child] failing also
causes [parent] to fail (and therefore all other children
of [parent]).
of [parent]). Default is [true].
Must be 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}. *)