diff --git a/src/fut.ml b/src/fut.ml index 000060f2..db2d24d7 100644 --- a/src/fut.ml +++ b/src/fut.ml @@ -354,7 +354,7 @@ let wait_block_exn self = | Ok x -> x | Error (e, bt) -> Printexc.raise_with_backtrace e bt -let await_exn (fut : 'a t) : 'a = +let await (fut : 'a t) : 'a = match peek fut with | Some res -> (* fast path: peek *) @@ -376,12 +376,6 @@ let await_exn (fut : 'a t) : 'a = (* un-suspended: we should have a result! *) get_or_fail_exn fut -let await fut = - try Ok (await_exn fut) - with exn -> - let bt = Printexc.get_raw_backtrace () in - Error (exn, bt) - module type INFIX = sig val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t diff --git a/src/fut.mli b/src/fut.mli index ac0e787a..b14893f4 100644 --- a/src/fut.mli +++ b/src/fut.mli @@ -149,19 +149,13 @@ val for_list : on:Pool.t -> 'a list -> ('a -> unit) -> unit t This is only available on OCaml 5. *) -val await : 'a t -> 'a or_error +val await : 'a t -> 'a (** [await fut] suspends the current tasks until [fut] is fulfilled, then resumes the task on this same pool. This must only be run from inside the pool itself. @since 0.3 {b NOTE}: only on OCaml 5 *) -val await_exn : 'a t -> 'a -(** Same as {!await} but re-raises. - @since 0.3 - {b NOTE}: only on OCaml 5 - *) - (** {2 Blocking} *) val wait_block : 'a t -> 'a or_error diff --git a/src/pool.ml b/src/pool.ml index b7779bb5..81aefce1 100644 --- a/src/pool.ml +++ b/src/pool.ml @@ -26,6 +26,7 @@ let add_global_thread_loop_wrapper f : unit = exception Shutdown +(** Run [task] as is, on the pool. *) let run_direct_ (self : t) (task : task) : unit = let n_qs = Array.length self.qs in let offset = A.fetch_and_add self.cur_q 1 in @@ -51,6 +52,8 @@ let run_direct_ (self : t) (task : task) : unit = | Exit -> () | Bb_queue.Closed -> raise Shutdown +(** Run [task]. It will be wrapped with an effect handler to + support {!Fut.await}. *) let run (self : t) (task : task) : unit = let task' () = (* run [f()] and handle [suspend] in it *) diff --git a/test/await/t_fib1.ml b/test/await/t_fib1.ml index 99beaac5..b7d61e9e 100644 --- a/test/await/t_fib1.ml +++ b/test/await/t_fib1.ml @@ -13,7 +13,7 @@ let fib ~on x : int Fut.t = else ( let t1 = Fut.spawn ~on (fun () -> fib_rec (x - 1)) and t2 = Fut.spawn ~on (fun () -> fib_rec (x - 2)) in - Fut.await_exn t1 + Fut.await_exn t2 + Fut.await t1 + Fut.await t2 ) in Fut.spawn ~on (fun () -> fib_rec x) diff --git a/test/await/t_futs1.ml b/test/await/t_futs1.ml index a345925a..aa974f45 100644 --- a/test/await/t_futs1.ml +++ b/test/await/t_futs1.ml @@ -4,7 +4,7 @@ let pool = Pool.create ~min:4 () let () = let fut = Array.init 10 (fun i -> Fut.spawn ~on:pool (fun () -> i)) in - let fut2 = Fut.spawn ~on:pool (fun () -> Array.map Fut.await_exn fut) in + let fut2 = Fut.spawn ~on:pool (fun () -> Array.map Fut.await fut) in assert (Fut.wait_block fut2 = Ok (Array.init 10 (fun x -> x))) let () = @@ -16,7 +16,7 @@ let () = else raise Not_found)) in - let fut2 = Fut.spawn ~on:pool (fun () -> Array.map Fut.await_exn fut) in + let fut2 = Fut.spawn ~on:pool (fun () -> Array.map Fut.await fut) in (* must fail *) assert (Fut.wait_block fut2 |> Result.is_error) @@ -28,7 +28,7 @@ let mk_ret_delay ?(on = pool) n x = let () = let f1 = mk_ret_delay 0.01 1 in let f2 = mk_ret_delay 0.01 2 in - let fut = Fut.spawn ~on:pool (fun () -> Fut.await_exn f1, Fut.await_exn f2) in + let fut = Fut.spawn ~on:pool (fun () -> Fut.await f1, Fut.await f2) in assert (Fut.wait_block_exn fut = (1, 2)) let () = @@ -38,7 +38,7 @@ let () = Thread.delay 0.01; 1) in - Fut.spawn ~on:pool (fun () -> Fut.await_exn f + 1) + Fut.spawn ~on:pool (fun () -> Fut.await f + 1) and f2 = let f = Fut.spawn ~on:pool (fun () -> @@ -47,7 +47,7 @@ let () = in Fut.spawn ~on:pool (fun () -> Thread.delay 0.01; - Fut.await_exn f * 2) + Fut.await f * 2) in let fut = Fut.both f1 f2 in assert (Fut.wait_block fut = Ok (2, 20)) diff --git a/test/await/t_many.ml b/test/await/t_many.ml index 9d3e18ef..7b29ae16 100644 --- a/test/await/t_many.ml +++ b/test/await/t_many.ml @@ -6,13 +6,13 @@ let run () = let t1 = Unix.gettimeofday () in let n = 1_000_000 in - let n_tasks = 10 in + let n_tasks = 3 in let task () = let l = List.init n (fun x -> Fut.spawn ~on:pool (fun () -> x)) in Fut.spawn ~on:pool (fun () -> List.fold_left (fun n x -> - let _res = Fut.await_exn x in + let _res = Fut.await x in n + 1) 0 l) in diff --git a/test/t_chan_train.ml b/test/t_chan_train.ml index 90a241c3..5d1c40ef 100644 --- a/test/t_chan_train.ml +++ b/test/t_chan_train.ml @@ -36,8 +36,8 @@ let rec mk_train n ic : _ Chan.t = let run () = let start = Unix.gettimeofday () in - let n_trains = 5 in - let len_train = 100 in + let n_trains = 4 in + let len_train = 80 in let n_events = 1_000 in let range = 5 in