Debuginfo.to_location and Location.print_compact

bytecomp/debuginfo.ml

@@ -54,3 +54,17 @@ let from_location kind loc =
 
 let from_call ev = from_location Dinfo_call ev.Lambda.lev_loc
 let from_raise ev = from_location Dinfo_raise ev.Lambda.lev_loc
+
+let to_location d =
+  if is_none d then Location.none
+  else
+    let loc_start =
+      { Lexing.
+        pos_fname = d.dinfo_file;
+        pos_lnum = d.dinfo_line;
+        pos_bol = 0;
+        pos_cnum = d.dinfo_char_start;
+      }
+    in
+    let loc_end = { loc_start with pos_cnum = d.dinfo_char_end; } in
+    { Location. loc_ghost = false; loc_start; loc_end; }

bytecomp/debuginfo.mli

@@ -30,3 +30,5 @@ val from_location: kind -> Location.t -> t
 
 val from_call: Lambda.lambda_event -> t
 val from_raise: Lambda.lambda_event -> t
+
+val to_location: t -> Location.t

parsing/location.ml

@@ -285,6 +285,17 @@ let print_error_prefix ppf () =
   ()
 ;;
 
+let print_compact ppf loc =
+  if loc.loc_start.pos_fname = "//toplevel//"
+  && highlight_locations ppf [loc] then ()
+  else begin
+    let (file, line, startchar) = get_pos_info loc.loc_start in
+    let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
+    fprintf ppf "%a:%i" print_filename file line;
+    if startchar >= 0 then fprintf ppf ",%i--%i" startchar endchar
+  end
+;;
+
 let print_error ppf loc =
   print ppf loc;
   print_error_prefix ppf ()

parsing/location.mli

@@ -77,6 +77,7 @@ val mknoloc : 'a -> 'a loc
 val mkloc : 'a -> t -> 'a loc
 
 val print: formatter -> t -> unit
+val print_compact: formatter -> t -> unit
 val print_filename: formatter -> string -> unit
 
 val absolute_path: string -> string