Improve printing of fatal errors

Currently, some fatal errors aren't printed because things fail before the printers are all registered. This PR registers the printers as early as possible. This way, all exceptions are properly printed. Signed-off-by: Rudi Grinberg <[email protected]>
ocaml · Jan 4, 2019 · 179dbd7 · 179dbd7
1 parent 723e17b
commit 179dbd7
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 3 deletions.
diff --git a/src/errors.ml b/src/errors.ml
@@ -118,9 +118,8 @@ let print ppf loc =
              print_ellipsis padding_width;
              print_lines last_shown_lines padding_width)
   in
-  Format.fprintf ppf
-    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
-    start.pos_fname start.pos_lnum start_c stop_c
+  Format.fprintf ppf "%a%a"
+    Loc.print loc
     pp_file_excerpt ()
 
 (* This is ugly *)

diff --git a/src/stdune/exn.ml b/src/stdune/exn.ml
@@ -10,6 +10,12 @@ external raise         : exn -> _ = "%raise"
 external raise_notrace : exn -> _ = "%raise_notrace"
 external reraise       : exn -> _ = "%reraise"
 
+let () =
+  Printexc.register_printer (function
+    | Code_error s -> Some (Format.asprintf "%a" Sexp.pp s)
+    | Loc_error (loc, s) -> Some (Format.asprintf "%a%s" Loc0.print loc s)
+    | _ -> None)
+
 let fatalf ?loc fmt =
   Format.ksprintf (fun s ->
     match loc with

diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli
@@ -21,3 +21,5 @@ val of_pos : (string * int * int * int) -> t
 
 val to_file_colon_line : t -> string
 val pp_file_colon_line : Format.formatter -> t -> unit
+
+val print : Format.formatter -> t -> unit
diff --git a/src/stdune/loc0.ml b/src/stdune/loc0.ml
@@ -2,3 +2,10 @@ type t =
   { start : Lexing.position
   ; stop  : Lexing.position
   }
+
+let print ppf { start; stop } =
+  let start_c = start.pos_cnum - start.pos_bol in
+  let stop_c  = stop.pos_cnum  - start.pos_bol in
+  Format.fprintf ppf
+    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n"
+    start.pos_fname start.pos_lnum start_c stop_c
Original file line number	Diff line number	Diff line change
Expand Up		@@ -21,3 +21,5 @@ val of_pos : (string * int * int * int) -> t

		val to_file_colon_line : t -> string
		val pp_file_colon_line : Format.formatter -> t -> unit

		val print : Format.formatter -> t -> unit