Source file exn.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
[@@@warning "+A"]

(** Thrown when a printing error happens. Using the standard entry_point
    [print_table] it shouldn't be possible. However, it is when using other
    functions without care. Please note that this is not the only exception that
    can be raised. For instance Invalid_argument is also possible.
*)
exception PrintError of string list

let () =
  let string_of_exception (e: exn) : string option =
    match e with
    | PrintError l ->
      let buf = Buffer.create 128 in
      let fmt = Format.formatter_of_buffer buf in
      let () = Format.pp_print_string fmt "PrintError(" in
      let () =
        match l with
        | [] -> ()
        | [s] -> Format.pp_print_string fmt s
        | h::t ->
          let () = Format.pp_print_string fmt h in
          let () = List.iter (Format.fprintf fmt ", %s") t in
          ()
      in
      let () = Format.fprintf fmt ")@?" in
      Some (Buffer.contents buf)
    | _ -> None
  in
  let () = Printexc.register_printer string_of_exception in
  ()