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
module List = Dune_caml.ListLabels
module String = Dune_caml.StringLabels
type t = exn
external raise : exn -> _ = "%raise"
external raise_notrace : exn -> _ = "%raise_notrace"
external reraise : exn -> _ = "%reraise"
let protectx x ~f ~finally =
match f x with
| y -> finally x; y
| exception e -> finally x; raise e
let protect ~f ~finally = protectx () ~f ~finally
let pp_uncaught ~backtrace fmt exn =
let s =
Printf.sprintf "%s\n%s" (Printexc.to_string exn) backtrace
|> String_split.split_lines
|> ListLabels.map ~f:(Printf.sprintf "| %s")
|> String.concat ~sep:"\n"
in
let line = String.make 71 '-' in
Format.fprintf fmt
"/%s\n\
| @{<error>Internal error@}: Uncaught exception.\n\
%s\n\
\\%s@."
line s line
let pp fmt exn =
Format.pp_print_string fmt (Printexc.to_string exn)
include
((struct
[@@@warning "-32-3"]
let raise_with_backtrace exn _ = reraise exn
include Printexc
let raise_with_backtrace exn bt = raise_with_backtrace exn bt
end) : (sig
val raise_with_backtrace: exn -> Printexc.raw_backtrace -> _
end))
let equal = (=)
let hash = Dune_caml.Hashtbl.hash
let to_dyn exn = Dyn.String (Printexc.to_string exn)