Source file `caller_id.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
(* Small helper to find out who is the caller of a function *)

let get ~skip =
  let skip = __FILE__ :: skip in
  let stack = Printexc.get_callstack 16 in
  let len = Printexc.raw_backtrace_length stack in
  let rec loop pos =
    if pos = len
    then None
    else (
      match
        Printexc.get_raw_backtrace_slot stack pos
        |> Printexc.convert_raw_backtrace_slot
        |> Printexc.Slot.location
      with
      | None -> None
      | Some loc ->
        if List.mem skip loc.filename ~equal:String.equal
        then loop (pos + 1)
        else (
          let start : Lexing.position =
            { pos_fname = loc.filename
            ; pos_lnum = loc.line_number
            ; pos_bol = 0
            ; pos_cnum = loc.start_char
            }
          in
          let stop = { start with pos_cnum = loc.end_char } in
          Some (Loc.create ~start ~stop)))
  in
  loop 0
;;