diff --git a/lib_eio/core/fiber.ml b/lib_eio/core/fiber.ml index 78c14282e..1035a1fe0 100644 --- a/lib_eio/core/fiber.ml +++ b/lib_eio/core/fiber.ml @@ -90,9 +90,9 @@ let await_cancel () = type 'a any_status = | New | Ex of (exn * Printexc.raw_backtrace) - | OK of 'a list + | OK of 'a -let rev_any fs = +let any_gen ~return ~combine fs = let r = ref New in let parent_c = Cancel.sub_unchecked Any (fun cc -> @@ -100,8 +100,8 @@ let rev_any fs = match h () with | x -> begin match !r with - | New -> r := OK [x]; Cancel.cancel cc Not_first - | OK ll -> r := OK (x :: ll) + | New -> r := OK (return x); Cancel.cancel cc Not_first + | OK prev -> r := OK (combine prev x) | Ex _ -> () end | exception Cancel.Cancelled _ when not (Cancel.is_on cc) -> @@ -111,7 +111,7 @@ let rev_any fs = () | exception ex -> begin match !r with - | New -> r := Ex (ex, Printexc.get_raw_backtrace ()); Cancel.cancel cc ex + | New -> r := Ex (ex, Printexc.get_raw_backtrace ()); Cancel.cancel cc ex | OK _ -> r := Ex (ex, Printexc.get_raw_backtrace ()) | Ex prev -> let bt = Printexc.get_raw_backtrace () in @@ -137,7 +137,7 @@ let rev_any fs = ) in match !r, Cancel.get_error parent_c with - | OK ll, None -> ll + | OK r, None -> r | (OK _ | New), Some ex -> raise ex | Ex (ex, bt), None -> Printexc.raise_with_backtrace ex bt | Ex ex1, Some ex2 -> @@ -146,18 +146,10 @@ let rev_any fs = Printexc.raise_with_backtrace ex bt | New, None -> assert false -let n_any ll = List.rev (rev_any ll) +let n_any fs = + List.rev (any_gen fs ~return:(fun x -> [x]) ~combine:(fun xs x -> x :: xs)) -let any ?(combine = (fun x _ -> x)) ll = - (* The results are backwards *) - let rec reduce_right = function - | [y; x] -> combine x y - | x :: rest -> combine (reduce_right rest) x - | [] -> assert false - in - match rev_any ll with - | [x] -> x - | ll -> reduce_right ll +let any ?(combine=(fun x _ -> x)) fs = any_gen fs ~return:Fun.id ~combine let first ?combine f g = any ?combine [f; g]