Source file `tracy_client.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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
type span = int
(* technically, [span] is [(bool,uint32)], but since tracy required 64 bits,
   it always fits *)

external _tracy_enter :
  file:string -> fun_:string -> line:int -> name:string -> depth:int -> span
  = "ml_tracy_enter"
  [@@noalloc]

external _tracy_exit : span -> unit = "ml_tracy_exit" [@@noalloc]
external _tracy_name_thread : string -> unit = "ml_tracy_name_thread"
external _tracy_msg : string -> unit = "ml_tracy_msg" [@@noalloc]
external _tracy_plot : string -> float -> unit = "ml_tracy_plot" [@@noalloc]
(* TODO external _tracy_set_plot_unit : string -> float -> unit = "ml_tracy_plot" *)

external _tracy_app_info : string -> unit = "ml_tracy_app_info"

external _tracy_span_text : span -> string -> unit = "ml_tracy_span_text"
  [@@noalloc]

external _tracy_span_value : span -> int64 -> unit = "ml_tracy_span_value"
  [@@noalloc]

external _tracy_span_color : span -> int -> unit = "ml_tracy_span_color"
  [@@noalloc]

let enter ?cs_depth ~__FILE__:file ~__LINE__:line ?(__FUNCTION__ = "<fun>") name
    : span =
  let depth =
    match cs_depth with
    | None -> 0
    | Some i -> i
  in
  _tracy_enter ~file ~fun_:__FUNCTION__ ~line ~name ~depth

(* TODO: in enter/tracy_enter,
   use ___tracy_emit_zone_value/color/text for bonus items *)

let exit = _tracy_exit
let name_thread = _tracy_name_thread
let message = _tracy_msg
let plot = _tracy_plot
let set_color = _tracy_span_color
let add_value = _tracy_span_value
let add_text = _tracy_span_text
let set_app_info = _tracy_app_info
let message_f k = k (fun fmt -> Format.kasprintf message fmt)
let add_text_f sp k = k (fun fmt -> Format.kasprintf (add_text sp) fmt)

let[@inline] with_ ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name f =
  let _sp = enter ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name in
  try
    let x = f _sp in
    exit _sp;
    x
  with e ->
    exit _sp;
    raise e