From 83408d4d6ac138d39a1af35bed1fc0420951e567 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 29 Nov 2016 16:43:54 -0800 Subject: [PATCH] ppx_compare TypeErr Reviewed By: sblackshear Differential Revision: D4232422 fbshipit-source-id: f25a67a --- infer/src/eradicate/typeErr.ml | 92 +++++---------------------------- infer/src/eradicate/typeErr.mli | 4 +- 2 files changed, 14 insertions(+), 82 deletions(-) diff --git a/infer/src/eradicate/typeErr.ml b/infer/src/eradicate/typeErr.ml index 79465bd26..3a4b911a4 100644 --- a/infer/src/eradicate/typeErr.ml +++ b/infer/src/eradicate/typeErr.ml @@ -18,10 +18,10 @@ module P = Printf (** Describe the origin of values propagated by the checker. *) module type InstrRefT = sig - type t + type t [@@deriving compare] + val equal : t -> t -> bool type generator val create_generator : Procdesc.Node.t -> generator - val equal : t -> t -> bool val gen : generator -> t val get_node : t -> Procdesc.Node.t val hash : t -> int @@ -32,10 +32,9 @@ end (* InstrRefT *) (** Per-node instruction reference. *) module InstrRef : InstrRefT = struct - type t = Procdesc.Node.t * int + type t = Procdesc.Node.t * int [@@deriving compare] + let equal x y = 0 = compare x y type generator = Procdesc.Node.t * int ref - let equal (n1, i1) (n2, i2) = - Procdesc.Node.equal n1 n2 && i1 = i2 let hash (n, i) = Hashtbl.hash (Procdesc.Node.hash n, i) let get_node (n, _) = n let replace_node (_, i) n' = (n', i) @@ -52,6 +51,9 @@ type origin_descr = Location.t option * Annotations.annotated_signature option (* callee signature *) +(* ignore origin descr *) +let compare_origin_descr _ _ = 0 + type parameter_not_nullable = Annotations.annotation * string * (* description *) @@ -59,6 +61,7 @@ type parameter_not_nullable = Procname.t * Location.t * (* callee location *) origin_descr +[@@deriving compare] (** Instance of an error *) type err_instance = @@ -75,83 +78,12 @@ type err_instance = | Parameter_annotation_inconsistent of parameter_not_nullable | Return_annotation_inconsistent of Annotations.annotation * Procname.t * origin_descr | Return_over_annotated of Procname.t +[@@deriving compare] module H = Hashtbl.Make(struct - type t = err_instance * InstrRef.t option - let err_instance_equal x y = match x, y with - | Condition_redundant (b1, so1, nn1), Condition_redundant (b2, so2, nn2) -> - bool_equal b1 b2 && - (opt_equal string_equal) so1 so2 && - bool_equal nn1 nn2 - | Condition_redundant _, _ - | _, Condition_redundant _ -> false - | Field_not_initialized (fn1, pn1), Field_not_initialized (fn2, pn2) -> - Ident.equal_fieldname fn1 fn2 && - Procname.equal pn1 pn2 - | Field_not_initialized (_, _), _ - | _, Field_not_initialized (_, _) -> false - | Field_not_mutable (fn1, _), Field_not_mutable (fn2, _) -> - Ident.equal_fieldname fn1 fn2 - | Field_not_mutable _, _ - | _, Field_not_mutable _ -> false - | Field_annotation_inconsistent (ann1, fn1, _), - Field_annotation_inconsistent (ann2, fn2, _) -> - ann1 = ann2 && - Ident.equal_fieldname fn1 fn2 - | Field_annotation_inconsistent _, _ - | _, Field_annotation_inconsistent _ -> false - | Field_over_annotated (fn1, pn1), Field_over_annotated (fn2, pn2) -> - Ident.equal_fieldname fn1 fn2 && - Procname.equal pn1 pn2 - | Field_over_annotated (_, _), _ - | _, Field_over_annotated (_, _) -> false - | Null_field_access (so1, fn1, _, ii1), Null_field_access (so2, fn2, _, ii2) -> - (opt_equal string_equal) so1 so2 && - Ident.equal_fieldname fn1 fn2 && - bool_equal ii1 ii2 - | Null_field_access _, _ - | _, Null_field_access _ -> false - | Call_receiver_annotation_inconsistent (ann1, so1, pn1, _), - Call_receiver_annotation_inconsistent (ann2, so2, pn2, _) -> - ann1 = ann2 && - (opt_equal string_equal) so1 so2 && - Procname.equal pn1 pn2 - | Call_receiver_annotation_inconsistent _, _ - | _, Call_receiver_annotation_inconsistent _ -> false - | Parameter_annotation_inconsistent (ann1, s1, n1, pn1, cl1, _), - Parameter_annotation_inconsistent (ann2, s2, n2, pn2, cl2, _) -> - ann1 = ann2 && - string_equal s1 s2 && - int_equal n1 n2 && - Procname.equal pn1 pn2 && - Location.equal cl1 cl2 - | Parameter_annotation_inconsistent _, _ - | _, Parameter_annotation_inconsistent _ -> false - | Return_annotation_inconsistent (ann1, pn1, _), - Return_annotation_inconsistent (ann2, pn2, _) -> - ann1 = ann2 && Procname.equal pn1 pn2 - | Return_annotation_inconsistent _, _ - | _, Return_annotation_inconsistent _ -> false - | Return_over_annotated pn1, Return_over_annotated pn2 -> - Procname.equal pn1 pn2 - | Inconsistent_subclass_return_annotation (pn1, spn1), - Inconsistent_subclass_return_annotation (pn2, spn2) -> - if Procname.equal pn1 pn2 then true - else Procname.equal spn1 spn2 - | Inconsistent_subclass_parameter_annotation (param_name_1, pos_1, pn_1, overriden_pn_1), - Inconsistent_subclass_parameter_annotation (param_name_2, pos_2, pn_2, overriden_pn_2) -> - string_equal param_name_1 param_name_2 && - int_equal pos_1 pos_2 && - Procname.equal pn_1 pn_2 && - Procname.equal overriden_pn_1 overriden_pn_2 - | Inconsistent_subclass_return_annotation _, _ - | _, Inconsistent_subclass_return_annotation _ -> false - | Inconsistent_subclass_parameter_annotation _, _ - | _, Inconsistent_subclass_parameter_annotation _ -> false - - let equal (err_inst1, instr_ref_opt1) (err_inst2, instr_ref_opt2) = - err_instance_equal err_inst1 err_inst2 && - opt_equal InstrRef.equal instr_ref_opt1 instr_ref_opt2 + type t = err_instance * InstrRef.t option [@@deriving compare] + + let equal x y = 0 = compare x y let err_instance_hash x = let string_hash s = Hashtbl.hash s in diff --git a/infer/src/eradicate/typeErr.mli b/infer/src/eradicate/typeErr.mli index d04c76d46..d46445684 100644 --- a/infer/src/eradicate/typeErr.mli +++ b/infer/src/eradicate/typeErr.mli @@ -15,10 +15,10 @@ open! Utils module type InstrRefT = sig - type t + type t [@@deriving compare] + val equal : t -> t -> bool type generator val create_generator : Procdesc.Node.t -> generator - val equal : t -> t -> bool val gen : generator -> t val get_node : t -> Procdesc.Node.t val hash : t -> int