Use explicit comparison function for Loc.t
Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
parent
35ea17ebc4
commit
c6d5faa79f
|
@ -274,7 +274,7 @@ let mlds t (doc : Documentation.t) =
|
||||||
let map = Lazy.force t.mlds in
|
let map = Lazy.force t.mlds in
|
||||||
match
|
match
|
||||||
List.find_map map ~f:(fun (doc', x) ->
|
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
|
with
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None ->
|
| None ->
|
||||||
|
|
|
@ -697,7 +697,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
Option.bind (Dir_contents.lookup_module dir_contents name)
|
Option.bind (Dir_contents.lookup_module dir_contents name)
|
||||||
~f:(fun buildable ->
|
~f:(fun buildable ->
|
||||||
List.find_map cctxs ~f:(fun (loc, cctx) ->
|
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
|
with
|
||||||
| None ->
|
| None ->
|
||||||
(* This happens often when passing a [-p ...] option that
|
(* This happens often when passing a [-p ...] option that
|
||||||
|
|
19
src/loc.ml
19
src/loc.ml
|
@ -77,3 +77,22 @@ let to_file_colon_line t =
|
||||||
|
|
||||||
let pp_file_colon_line ppf t =
|
let pp_file_colon_line ppf t =
|
||||||
Format.pp_print_string ppf (to_file_colon_line 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
|
||||||
|
|
|
@ -3,6 +3,8 @@ type t = Usexp.Loc.t =
|
||||||
; stop : Lexing.position
|
; stop : Lexing.position
|
||||||
}
|
}
|
||||||
|
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
|
||||||
val sexp_of_t : t -> Usexp.t
|
val sexp_of_t : t -> Usexp.t
|
||||||
|
|
||||||
val of_lexbuf : Lexing.lexbuf -> t
|
val of_lexbuf : Lexing.lexbuf -> t
|
||||||
|
|
|
@ -114,7 +114,12 @@ let report exn =
|
||||||
let backtrace = Printexc.get_raw_backtrace () in
|
let backtrace = Printexc.get_raw_backtrace () in
|
||||||
let ppf = err_ppf in
|
let ppf = err_ppf in
|
||||||
let p = report_with_backtrace exn 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);
|
Option.iter loc ~f:(fun loc -> Loc.print ppf loc);
|
||||||
p.pp ppf;
|
p.pp ppf;
|
||||||
Format.pp_print_flush ppf ();
|
Format.pp_print_flush ppf ();
|
||||||
|
|
|
@ -52,3 +52,10 @@ let both x y =
|
||||||
let to_list = function
|
let to_list = function
|
||||||
| None -> []
|
| None -> []
|
||||||
| Some x -> [x]
|
| 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
|
||||||
|
|
|
@ -26,3 +26,5 @@ val is_none : _ t -> bool
|
||||||
val both : 'a t -> 'b t -> ('a * 'b) t
|
val both : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
|
||||||
val to_list : 'a t -> 'a list
|
val to_list : 'a t -> 'a list
|
||||||
|
|
||||||
|
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
||||||
|
|
|
@ -7,6 +7,7 @@ include struct
|
||||||
let uncapitalize_ascii = String.uncapitalize
|
let uncapitalize_ascii = String.uncapitalize
|
||||||
let uppercase_ascii = String.uppercase
|
let uppercase_ascii = String.uppercase
|
||||||
let lowercase_ascii = String.lowercase
|
let lowercase_ascii = String.lowercase
|
||||||
|
let equal (a:string) b = Pervasives.(=) a b
|
||||||
end
|
end
|
||||||
|
|
||||||
include StringLabels
|
include StringLabels
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
include module type of struct include StringLabels end
|
include module type of struct include StringLabels end
|
||||||
|
|
||||||
|
val equal : t -> t -> bool
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
|
|
||||||
val break : t -> pos:int -> t * t
|
val break : t -> pos:int -> t * t
|
||||||
|
|
Loading…
Reference in New Issue