Use explicit comparison function for Loc.t

Signed-off-by: Etienne Millon <me@emillon.org>

src/dir_contents.ml

@@ -274,7 +274,7 @@ let mlds t (doc : Documentation.t) =
   let map = Lazy.force t.mlds in
   match
     List.find_map map ~f:(fun (doc', x) ->
-      Option.some_if (doc.loc = doc'.loc) x)
+      Option.some_if (Loc.equal doc.loc doc'.loc) x)
   with
   | Some x -> x
   | None ->

src/gen_rules.ml

@@ -697,7 +697,7 @@ module Gen(P : Install_rules.Params) = struct
               Option.bind (Dir_contents.lookup_module dir_contents name)
                 ~f:(fun buildable ->
                   List.find_map cctxs ~f:(fun (loc, cctx) ->
-                    Option.some_if (loc = buildable.loc) cctx)))
+                    Option.some_if (Loc.equal loc buildable.loc) cctx)))
         with
         | None ->
           (* This happens often when passing a [-p ...] option that

src/loc.ml

@@ -77,3 +77,22 @@ let to_file_colon_line t =
 
 let pp_file_colon_line ppf t =
   Format.pp_print_string ppf (to_file_colon_line t)
+
+let equal_position
+      { Lexing.pos_fname = f_a; pos_lnum = l_a
+      ; pos_bol = b_a; pos_cnum = c_a }
+      { Lexing.pos_fname = f_b; pos_lnum = l_b
+      ; pos_bol = b_b; pos_cnum = c_b }
+      =
+      let open Int.Infix in
+      String.equal f_a f_b
+      && l_a = l_b
+      && b_a = b_b
+      && c_a = c_b
+
+let equal
+      { start = start_a ; stop = stop_a }
+      { start = start_b ; stop = stop_b }
+  =
+  equal_position start_a start_b
+  && equal_position stop_a stop_b

src/loc.mli

@@ -3,6 +3,8 @@ type t = Usexp.Loc.t =
   ; stop  : Lexing.position
   }
 
+val equal : t -> t -> bool
+
 val sexp_of_t : t -> Usexp.t
 
 val of_lexbuf : Lexing.lexbuf -> t

src/report_error.ml

@@ -114,7 +114,12 @@ let report exn =
     let backtrace = Printexc.get_raw_backtrace () in
     let ppf = err_ppf in
     let p = report_with_backtrace exn in
-    let loc = if p.loc = Some Loc.none then None else p.loc in
+    let loc =
+      if Option.equal Loc.equal p.loc (Some Loc.none) then
+        None
+      else
+        p.loc
+    in
     Option.iter loc ~f:(fun loc -> Loc.print ppf loc);
     p.pp ppf;
     Format.pp_print_flush ppf ();

src/stdune/option.ml

@@ -52,3 +52,10 @@ let both x y =
 let to_list = function
   | None -> []
   | Some x -> [x]
+
+let equal eq x y =
+  match (x, y) with
+  | None, None -> true
+  | Some _, None -> false
+  | None, Some _ -> false
+  | Some sx, Some sy -> eq sx sy

src/stdune/option.mli

@@ -26,3 +26,5 @@ val is_none : _ t -> bool
 val both : 'a t -> 'b t -> ('a * 'b) t
 
 val to_list : 'a t -> 'a list
+
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool

src/stdune/string.ml

@@ -7,6 +7,7 @@ include struct
   let uncapitalize_ascii = String.uncapitalize
   let uppercase_ascii    = String.uppercase
   let lowercase_ascii    = String.lowercase
+  let equal (a:string) b = Pervasives.(=) a b
 end
 
 include StringLabels

src/stdune/string.mli

@@ -1,5 +1,6 @@
 include module type of struct include StringLabels end
 
+val equal : t -> t -> bool
 val compare : t -> t -> Ordering.t
 
 val break : t -> pos:int -> t * t