[sledge] Improve: Print locations with relative pathnames

Reviewed By: ngorogiannis

Differential Revision: D23459523

fbshipit-source-id: 26f99f7c3

sledge/dune

@@ -38,7 +38,7 @@
  (library
   (name llair)
   (public_name sledge.llair)
-  (libraries nonstdlib)
+  (libraries nonstdlib fpath)
   (flags
    (:standard -open NS))
   (preprocess

sledge/sledge.opam

@@ -18,6 +18,7 @@ depends: [
   "ctypes-foreign"
   "dune" {build & >= "2.7"}
   "dune-build-info" {build}
+  "fpath"
   "iter"
   "llvm" {= "8.0.0"}
   "ppx_compare"

sledge/src/llair/global.ml

@@ -19,10 +19,9 @@ let pp fs {reg} =
   pf "@%s%a" name Reg.pp_demangled reg
 
 let pp_defn fs {reg; init; loc} =
-  Format.fprintf fs "@[<2>%a %a%a%a@]" Typ.pp (Reg.typ reg) Reg.pp reg
+  Format.fprintf fs "@[<2>%a %a%a %a@]" Typ.pp (Reg.typ reg) Reg.pp reg
-    Loc.pp loc
     (Option.pp "@ = @[%a@]" Exp.pp)
-    (Option.map ~f:fst init)
+    (Option.map ~f:fst init) Loc.pp loc
 
 let invariant g =
   let@ () = Invariant.invariant [%here] g [%sexp_of: t] in

sledge/src/llair/loc.ml

@@ -13,12 +13,21 @@ type t = {dir: string; file: string; line: int; col: int}
 let none = {dir= ""; file= ""; line= 0; col= 0}
 
 let mk ?(dir = none.dir) ?(file = none.file) ?(col = none.col) ~line =
+  let dir = if String.is_empty dir then dir else Filename.realpath dir in
   {dir; file; line; col}
 
-let pp fs {dir; file; line; col} =
+let root = ref (Filename.realpath (Sys.getcwd ()))
+
+let pp fs ({dir; file; line; col} as loc) =
+  if not (equal loc none) then Format.pp_print_string fs "; " ;
+  if not (String.is_empty dir) then (
+    let dir =
+      Option.value_map ~f:Fpath.to_string
+        (Fpath.relativize ~root:(Fpath.v !root) (Fpath.v dir))
+        ~default:dir
+    in
     Format.pp_print_string fs dir ;
-  if not (String.is_empty dir) then
+    Format.pp_print_string fs Filename.dir_sep ) ;
-    Format.pp_print_string fs Filename.dir_sep ;
   Format.pp_print_string fs file ;
   if not (String.is_empty file) then Format.pp_print_char fs ':' ;
   if line > 0 then (

sledge/src/llair/loc.mli

@@ -13,3 +13,6 @@ type t = {dir: string; file: string; line: int; col: int}
 val pp : t pp
 val none : t
 val mk : ?dir:string -> ?file:string -> ?col:int -> line:int -> t
+
+val root : string ref
+(** pathnames are printed relative to [root], defaults to working directory *)