1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
(* Lwt.join is a great way to run multiple threads in parallel. However it has this really annoying
* property where it won't exit early if one of the threads fails. It's not a big deal if you
* expect this behavior, but it can be dangerous if you expect the same behavior as Promise.all or
* Hack's await.
*
* We can instead simulate how Lwt.join should work by calling Lwt.nchoose multiple times until
* one thread throws an exception or until all threads have finished.
*
* In the exceptional case, we won't cancel the still-sleeping threads. I (glevi) tried to get this
* to work, but it wouldn't preserve stack traces. Anyway, Promise.all doesn't cancel running
* promises either :P
*)
if threads = [ then
return_unit
else
(* If any thread in threads fails during this nchoose, the whole all function will fail *)
let%lwt = nchoose_split threads in
iter_all sleeping_threads
match state thread x
failwith "Not yet completed"
let%lwt ( = iter_all threads in
threads |> map ~f:get_value_unsafe |> return
let%lwt ( = fprint out "digraph {\n" in
let%lwt ( =
iter_s
graph
in
fprint out "}"