mirror of
https://github.com/ocaml-multicore/eio.git
synced 2025-10-10 00:03:07 -04:00
Remove Fork effect
`Fork_ignore` can be used to implement it just as easily.
This commit is contained in:
parent
84d66fa050
commit
bc3b0276a2
@ -293,7 +293,6 @@ module Private = struct
|
|||||||
type 'a enqueue = 'a Suspend.enqueue
|
type 'a enqueue = 'a Suspend.enqueue
|
||||||
type _ eff +=
|
type _ eff +=
|
||||||
| Suspend = Suspend.Suspend
|
| Suspend = Suspend.Suspend
|
||||||
| Fork = Fibre.Fork
|
|
||||||
| Fork_ignore = Fibre.Fork_ignore
|
| Fork_ignore = Fibre.Fork_ignore
|
||||||
| Get_context = Cancel.Get_context
|
| Get_context = Cancel.Get_context
|
||||||
| Trace = Std.Trace
|
| Trace = Std.Trace
|
||||||
|
@ -655,9 +655,6 @@ module Private : sig
|
|||||||
passing it the suspended fibre's context and a function to resume it.
|
passing it the suspended fibre's context and a function to resume it.
|
||||||
[fn] should arrange for [enqueue] to be called once the thread is ready to run again. *)
|
[fn] should arrange for [enqueue] to be called once the thread is ready to run again. *)
|
||||||
|
|
||||||
| Fork : Fibre_context.t * (unit -> 'a) -> 'a Promise.t eff
|
|
||||||
(** See {!Fibre.fork} *)
|
|
||||||
|
|
||||||
| Fork_ignore : Fibre_context.t * (unit -> unit) -> unit eff
|
| Fork_ignore : Fibre_context.t * (unit -> unit) -> unit eff
|
||||||
(** See {!Fibre.fork_ignore} *)
|
(** See {!Fibre.fork_ignore} *)
|
||||||
|
|
||||||
|
@ -1,12 +1,5 @@
|
|||||||
open EffectHandlers
|
open EffectHandlers
|
||||||
|
|
||||||
type _ eff += Fork : Cancel.fibre_context * (unit -> 'a) -> 'a Promise.t eff
|
|
||||||
|
|
||||||
let fork ~sw f =
|
|
||||||
let f () = Switch.with_op sw f in
|
|
||||||
let new_fibre = Cancel.Fibre_context.make ~cc:sw.cancel in
|
|
||||||
perform (Fork (new_fibre, f))
|
|
||||||
|
|
||||||
type _ eff += Fork_ignore : Cancel.fibre_context * (unit -> unit) -> unit eff
|
type _ eff += Fork_ignore : Cancel.fibre_context * (unit -> unit) -> unit eff
|
||||||
|
|
||||||
let fork_ignore ~sw f =
|
let fork_ignore ~sw f =
|
||||||
@ -18,6 +11,17 @@ let fork_ignore ~sw f =
|
|||||||
let new_fibre = Cancel.Fibre_context.make ~cc:sw.cancel in
|
let new_fibre = Cancel.Fibre_context.make ~cc:sw.cancel in
|
||||||
perform (Fork_ignore (new_fibre, f))
|
perform (Fork_ignore (new_fibre, f))
|
||||||
|
|
||||||
|
let fork ~sw f =
|
||||||
|
let new_fibre = Cancel.Fibre_context.make ~cc:sw.Switch.cancel in
|
||||||
|
let p, r = Promise.create_with_id (Cancel.Fibre_context.tid new_fibre) in
|
||||||
|
let f () =
|
||||||
|
match Switch.with_op sw f with
|
||||||
|
| x -> Promise.fulfill r x
|
||||||
|
| exception ex -> Promise.break r ex
|
||||||
|
in
|
||||||
|
perform (Fork_ignore (new_fibre, f));
|
||||||
|
p
|
||||||
|
|
||||||
let yield () =
|
let yield () =
|
||||||
let fibre = Suspend.enter (fun fibre enqueue -> enqueue (Ok fibre)) in
|
let fibre = Suspend.enter (fun fibre enqueue -> enqueue (Ok fibre)) in
|
||||||
Cancel.check fibre.cancel_context
|
Cancel.check fibre.cancel_context
|
||||||
@ -30,13 +34,18 @@ let both f g = all [f; g]
|
|||||||
|
|
||||||
let pair f g =
|
let pair f g =
|
||||||
Cancel.sub @@ fun cancel ->
|
Cancel.sub @@ fun cancel ->
|
||||||
let f _fibre =
|
|
||||||
try f ()
|
|
||||||
with ex -> Cancel.cancel cancel ex; raise ex
|
|
||||||
in
|
|
||||||
let x =
|
let x =
|
||||||
|
let p, r = Promise.create () in
|
||||||
|
let f _fibre =
|
||||||
|
match f () with
|
||||||
|
| x -> Promise.fulfill r x
|
||||||
|
| exception ex ->
|
||||||
|
Cancel.cancel cancel ex;
|
||||||
|
Promise.break r ex
|
||||||
|
in
|
||||||
let new_fibre = Cancel.Fibre_context.make ~cc:cancel in
|
let new_fibre = Cancel.Fibre_context.make ~cc:cancel in
|
||||||
perform (Fork (new_fibre, f))
|
perform (Fork_ignore (new_fibre, f));
|
||||||
|
p
|
||||||
in
|
in
|
||||||
match g () with
|
match g () with
|
||||||
| gr -> Promise.await x, gr (* [g] succeeds - just report [f]'s result *)
|
| gr -> Promise.await x, gr (* [g] succeeds - just report [f]'s result *)
|
||||||
@ -99,7 +108,13 @@ let any fs =
|
|||||||
| [f] -> wrap f (); []
|
| [f] -> wrap f (); []
|
||||||
| f :: fs ->
|
| f :: fs ->
|
||||||
let new_fibre = Cancel.Fibre_context.make ~cc in
|
let new_fibre = Cancel.Fibre_context.make ~cc in
|
||||||
let p = perform (Fork (new_fibre, wrap f)) in
|
let p, r = Promise.create () in
|
||||||
|
let f () =
|
||||||
|
match wrap f () with
|
||||||
|
| x -> Promise.fulfill r x
|
||||||
|
| exception ex -> Promise.break r ex
|
||||||
|
in
|
||||||
|
perform (Fork_ignore (new_fibre, f));
|
||||||
p :: aux fs
|
p :: aux fs
|
||||||
in
|
in
|
||||||
let ps = aux fs in
|
let ps = aux fs in
|
||||||
|
@ -1052,20 +1052,6 @@ let rec run ?(queue_depth=64) ?(block_size=4096) main =
|
|||||||
);
|
);
|
||||||
schedule st
|
schedule st
|
||||||
)
|
)
|
||||||
| Eio.Private.Effects.Fork (new_fibre, f) -> Some (fun k ->
|
|
||||||
let k = { Suspended.k; fibre } in
|
|
||||||
let promise, resolver = Promise.create_with_id (Fibre_context.tid new_fibre) in
|
|
||||||
enqueue_thread st k promise;
|
|
||||||
fork
|
|
||||||
~new_fibre
|
|
||||||
(fun () ->
|
|
||||||
match f () with
|
|
||||||
| x -> Promise.fulfill resolver x
|
|
||||||
| exception ex ->
|
|
||||||
Log.debug (fun f -> f "Forked fibre failed: %a" Fmt.exn ex);
|
|
||||||
Promise.break resolver ex
|
|
||||||
)
|
|
||||||
)
|
|
||||||
| Eio.Private.Effects.Fork_ignore (new_fibre, f) -> Some (fun k ->
|
| Eio.Private.Effects.Fork_ignore (new_fibre, f) -> Some (fun k ->
|
||||||
let k = { Suspended.k; fibre } in
|
let k = { Suspended.k; fibre } in
|
||||||
enqueue_thread st k ();
|
enqueue_thread st k ();
|
||||||
|
@ -625,20 +625,6 @@ let rec run main =
|
|||||||
fn loop fibre (enqueue_thread st k))
|
fn loop fibre (enqueue_thread st k))
|
||||||
| Eio.Private.Effects.Trace ->
|
| Eio.Private.Effects.Trace ->
|
||||||
Some (fun k -> continue k Eunix.Trace.default_traceln)
|
Some (fun k -> continue k Eunix.Trace.default_traceln)
|
||||||
| Eio.Private.Effects.Fork (new_fibre, f) ->
|
|
||||||
Some (fun k ->
|
|
||||||
let k = { Suspended.k; fibre } in
|
|
||||||
let promise, resolver = Promise.create_with_id (Fibre_context.tid new_fibre) in
|
|
||||||
enqueue_thread st k promise;
|
|
||||||
fork
|
|
||||||
~new_fibre
|
|
||||||
(fun () ->
|
|
||||||
match f () with
|
|
||||||
| x -> Promise.fulfill resolver x
|
|
||||||
| exception ex ->
|
|
||||||
Log.debug (fun f -> f "Forked fibre failed: %a" Fmt.exn ex);
|
|
||||||
Promise.break resolver ex
|
|
||||||
))
|
|
||||||
| Eio.Private.Effects.Fork_ignore (new_fibre, f) ->
|
| Eio.Private.Effects.Fork_ignore (new_fibre, f) ->
|
||||||
Some (fun k ->
|
Some (fun k ->
|
||||||
let k = { Suspended.k; fibre } in
|
let k = { Suspended.k; fibre } in
|
||||||
|
Loading…
x
Reference in New Issue
Block a user