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.{return,fail}

Browse source
This commit is contained in:
Simon Cruanes 2024-03-04 12:37:01 -05:00
parent 5817a8aee7
commit 66f95df3b4
2 changed files with 30 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
src/fib/fiber.ml
View file

@ -44,6 +44,33 @@ end
include Private_ include Private_
let create_ ~ls ~runner () : 'a t =
let id = Handle.generate_fresh () in
let res, _promise = Fut.make () in
{
state =
A.make
@@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
id;
res;
runner;
ls;
}
let create_done_ ~res () : _ t =
let id = Handle.generate_fresh () in
{
state =
A.make
@@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
id;
res;
runner = Immediate_runner.runner;
ls = Task_local_storage.dummy;
}
let[@inline] return x = create_done_ ~res:(Fut.return x) ()
let[@inline] fail ebt = create_done_ ~res:(Fut.fail_exn_bt ebt) ()
let[@inline] res self = self.res let[@inline] res self = self.res
let[@inline] peek self = Fut.peek self.res let[@inline] peek self = Fut.peek self.res
let[@inline] is_done self = Fut.is_done self.res let[@inline] is_done self = Fut.is_done self.res
@ -212,19 +239,6 @@ let add_child_ ~protect (self : _ t) (child : _ t) =
() ()
done done
let create_ ~ls ~runner () : 'a t =
let id = Handle.generate_fresh () in
let res, _promise = Fut.make () in
{
state =
A.make
@@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
id;
res;
runner;
ls;
}
let spawn_ ~ls ~parent ~runner (f : unit -> 'a) : 'a t = let spawn_ ~ls ~parent ~runner (f : unit -> 'a) : 'a t =
(match parent with (match parent with
| Some p when is_closed p -> failwith "spawn: nursery is closed" | Some p when is_closed p -> failwith "spawn: nursery is closed"

3
src/fib/fiber.mli
View file

@ -46,6 +46,9 @@ type 'a callback = 'a Exn_bt.result -> unit
(** Type erased fiber *) (** Type erased fiber *)
type any = Private_.any = Any : _ t -> any [@@unboxed] type any = Private_.any = Any : _ t -> any [@@unboxed]
val return : 'a -> 'a t
val fail : Exn_bt.t -> _ t
val self : unit -> any val self : unit -> any
(** [self ()] is the current fiber. (** [self ()] is the current fiber.
Must be run from inside a fiber. Must be run from inside a fiber.