Source file miou_trace.ml

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
type event = ..

type event +=
  | Spawn of {
        uid: int
      ; parent: int
      ; runner: int
      ; kind: [ `Async | `Parallel ]
    }
  | Spawn_location of { uid: int; filename: string; line: int }
  | Cancel of int
  | Cancelled of int
  | Await of int
  | Resume of int
  | Yield of int
  | Suspend of { name: string; uid: int }
  | Continue of { name: string; uid: int }
  | Attach of { ruid: int; puid: int }
  | Detach of { ruid: int; puid: int }
  | Run_begin of int
  | Run_end of int
  | Run_done of int
  | Clean of { self: int; child: int }
  | Still_has_children of int
  | Not_a_child of { self: int; prm: int }
  | Resource_leaked of int
  | Not_owner of { ruid: int; puid: int }

let reporter : (event -> unit) Atomic.t = Atomic.make ignore
let set_reporter fn = Atomic.set reporter fn
let miou_trace = Sys.getenv_opt "MIOU_TRACE"

let trace event =
  match miou_trace with Some _ -> (Atomic.get reporter) event | _ -> ()