ppx_compare TypeAnnotations

Reviewed By: sblackshear

Differential Revision: D4232414

fbshipit-source-id: 216f35b

infer/src/checkers/annotations.ml

@@ -18,19 +18,7 @@ module L = Logging
 type annotated_signature = {
   ret : Annot.Item.t * Typ.t; (** Annotated return type. *)
   params: (Mangled.t * Annot.Item.t * Typ.t) list (** Annotated parameters. *)
-}
-
-let param_equal (s1, ia1, t1) (s2, ia2, t2) =
-  Mangled.equal s1 s2 &&
-  Annot.Item.compare ia1 ia2 = 0 &&
-  Typ.equal t1 t2
-
-let equal as1 as2 =
-  let ia1, t1 = as1.ret
-  and ia2, t2 = as2.ret in
-  Annot.Item.compare ia1 ia2 = 0 &&
-  Typ.equal t1 t2 &&
-  IList.for_all2 param_equal as1.params as2.params
+} [@@deriving compare]
 
 let visibleForTesting = "com.google.common.annotations.VisibleForTesting"
 let suppressLint = "android.annotation.SuppressLint"
@@ -228,6 +216,7 @@ let ia_is_guarded_by ia =
 type annotation =
   | Nullable
   | Present
+[@@deriving compare]
 
 let ia_is ann ia = match ann with
   | Nullable -> ia_is_nullable ia

infer/src/checkers/annotations.mli

@@ -22,12 +22,13 @@ val suppress_warnings : string
 type annotation =
   | Nullable
   | Present
+[@@deriving compare]
 
 (** Method signature with annotations. *)
 type annotated_signature = {
   ret : Annot.Item.t * Typ.t; (** Annotated return type. *)
   params: (Mangled.t * Annot.Item.t * Typ.t) list (** Annotated parameters. *)
-}
+} [@@deriving compare]
 
 (** Check if the annotated signature is for a wrapper of an anonymous inner class method.
     These wrappers have the same name as the original method, every type is Object, and the parameters
@@ -49,8 +50,6 @@ val annotated_signature_mark_return :
 val annotated_signature_mark_return_strict :
   annotated_signature -> annotated_signature
 
-val equal : annotated_signature -> annotated_signature -> bool
-
 (** Get a method signature with annotations from a proc_attributes. *)
 val get_annotated_signature : ProcAttributes.t -> annotated_signature
 

infer/src/eradicate/typeAnnotation.ml

@@ -18,18 +18,15 @@ module P = Printf
 module AnnotationsMap = Map.Make (
   struct
     open Annotations
-    type t = annotation
-    let compare a1 a2 = match a1, a2 with
-      | Nullable, Nullable -> 0
-      | Nullable, _ -> -1
-      | _, Nullable -> 1
-      | Present, Present -> 0
+    type t = annotation [@@deriving compare]
   end)
 
 type t = {
   map : bool AnnotationsMap.t;
   origin : TypeOrigin.t;
-}
+} [@@deriving compare]
+
+let equal ta1 ta2 = 0 = compare ta1 ta2
 
 let get_value ann ta =
   try
@@ -54,12 +51,6 @@ let set_nullable b =
 let set_present b =
   set_value Annotations.Present b
 
-
-let equal ta1 ta2 =
-  bool_equal (get_nullable ta1) (get_nullable ta2) &&
-  bool_equal (get_present ta1) (get_present ta2) &&
-  TypeOrigin.equal ta1.origin ta2.origin
-
 let to_string ta =
   let nullable_s = if get_nullable ta then " @Nullable" else "" in
   let present_s = if get_present ta then " @Present" else "" in

infer/src/eradicate/typeAnnotation.mli

@@ -11,14 +11,15 @@ open! Utils
 
 (** Nodule to represent annotations on types. *)
 
-type t
+type t [@@deriving compare]
+
+val equal : t -> t -> bool
 
 val const : Annotations.annotation -> bool -> TypeOrigin.t -> t
 
 (** Human-readable description of the origin of a nullable value. *)
 val descr_origin : Tenv.t -> t -> TypeErr.origin_descr
 
-val equal : t -> t -> bool
 val from_item_annotation : Annot.Item.t -> TypeOrigin.t -> t
 val get_origin : t -> TypeOrigin.t
 val get_value : Annotations.annotation -> t -> bool

infer/src/eradicate/typeOrigin.ml

@@ -22,7 +22,7 @@ type proc_origin =
     loc: Location.t;
     annotated_signature : Annotations.annotated_signature;
     is_library : bool;
-  }
+  } [@@deriving compare]
 
 type t =
   | Const of Location.t
@@ -32,38 +32,9 @@ type t =
   | New
   | ONone
   | Undef
+[@@deriving compare]
 
-let proc_origin_equal po1 po2 =
-  Procname.equal po1.pname po2.pname &&
-  Location.equal po1.loc po2.loc &&
-  Annotations.equal po1.annotated_signature po2.annotated_signature &&
-  bool_equal po1.is_library po2.is_library
-
-let equal o1 o2 = match o1, o2 with
-  | Const loc1, Const loc2 ->
-      Location.equal loc1 loc2
-  | Const _, _
-  | _, Const _ -> false
-  | Field (fn1, loc1), Field (fn2, loc2) ->
-      Ident.equal_fieldname fn1 fn2 &&
-      Location.equal loc1 loc2
-  | Field _, _
-  | _, Field _ -> false
-  | Formal s1, Formal s2 ->
-      Mangled.equal s1 s2
-  | Formal _, _
-  | _, Formal _ -> false
-  | Proc po1 , Proc po2 ->
-      proc_origin_equal po1 po2
-  | Proc _, _
-  | _, Proc _ -> false
-  | New, New -> true
-  | New, _
-  | _, New -> false
-  | ONone, ONone -> true
-  | ONone, _
-  | _, ONone -> false
-  | Undef, Undef -> true
+let equal o1 o2 = 0 = compare o1 o2
 
 let to_string = function
   | Const _ -> "Const"

infer/src/eradicate/typeOrigin.mli

@@ -16,7 +16,7 @@ type proc_origin =
     loc: Location.t;
     annotated_signature : Annotations.annotated_signature;
     is_library : bool;
-  }
+  } [@@deriving compare]
 
 type t =
   | Const of Location.t (** A constant in the source *)
@@ -26,6 +26,7 @@ type t =
   | New (** A new object creation *)
   | ONone (** No origin is known *)
   | Undef (** Undefined value before initialization *)
+[@@deriving compare]
 
 val equal : t -> t -> bool
 

infer/src/eradicate/typeState.ml

@@ -44,13 +44,18 @@ module M = Map.Make (struct
     type t = Exp.t
     let compare = Exp.compare end)
 
-type range = Typ.t * TypeAnnotation.t * (Location.t list)
+type range = Typ.t * TypeAnnotation.t * (Location.t list) [@@deriving compare]
 
 type 'a t =
   {
     map: range M.t;
     extension : 'a;
-  }
+  } [@@deriving compare]
+
+(* Ignore the extension field, which is a pure instrumentation *)
+let compare t1 t2 = compare_t (fun _ _ -> 0) t1 t2
+
+let equal t1 t2 = 0 = compare t1 t2
 
 let empty ext =
   {
@@ -58,16 +63,6 @@ let empty ext =
     extension = ext.empty;
   }
 
-let locs_compare = IList.compare Location.compare
-let locs_equal locs1 locs2 = locs_compare locs1 locs2 = 0
-
-let range_equal (typ1, ta1, locs1) (typ2, ta2, locs2) =
-  Typ.equal typ1 typ2 && TypeAnnotation.equal ta1 ta2 && locs_equal locs1 locs2
-
-let equal t1 t2 =
-  (* Ignore the calls field, which is a pure instrumentation *)
-  M.equal range_equal t1.map t2.map
-
 let pp ext fmt typestate =
   let pp_loc fmt loc = F.fprintf fmt "%d" loc.Location.line in
   let pp_locs fmt locs = F.fprintf fmt " [%a]" (pp_seq pp_loc) locs in