[utils] add tags_compare utility to make writing default comparison functions easy

Differential Revision: D4020123

fbshipit-source-id: ace1a03

infer/src/base/Utils.ml

@@ -81,6 +81,23 @@ let trd3 (_,_,x) = x
 
 let int_of_bool b = if b then 1 else 0
 
+let tags_compare (x : 'a) (y : 'a) =
+  let x = Obj.repr x
+  and y = Obj.repr y in
+  if Obj.is_int x
+  then
+    if Obj.is_int y
+    (* we can use (-) because tags are small and won't overflow *)
+    then Obj.obj x - Obj.obj y
+    else -1
+  else if Obj.is_int y
+  then 1
+  else
+    let r = Obj.tag x - Obj.tag y in
+    if r = 0
+    then failwith "Comparing parameterized constructors"
+    else r
+
 (** {2 Useful Modules} *)
 
 (** Set of integers *)

infer/src/base/Utils.mli

@@ -69,6 +69,10 @@ val string_equal : string -> string -> bool
 (** Comparison for floats *)
 val float_compare : float -> float -> int
 
+(** Use this function to compare sum types (ONLY!) in the default case of your custom compare
+    function. It will fail if you try to check equality of parameterized constructors *)
+val tags_compare: 'a -> 'a -> int
+
 (** Return the first component of a triple. *)
 val fst3 : 'a * 'b * 'c -> 'a
 

infer/src/quandary/CppTrace.ml

@@ -22,12 +22,7 @@ module CppSource = struct
 
     let compare sk1 sk2 = match sk1, sk2 with
       | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2
-      | Footprint _, _ -> (-1)
+      | _ -> tags_compare sk1 sk2
-      | _, Footprint _ -> 1
-      | EnvironmentVariable, EnvironmentVariable -> 0
-      | EnvironmentVariable, _ -> (-1)
-      | _, EnvironmentVariable -> 1
-      | Other, Other -> 0
   end
 
   type kind = SourceKind.t
@@ -107,11 +102,7 @@ module CppSink = struct
       | ShellExec (** shell exec function *)
       | Other (** for testing or uncategorized sinks *)
 
-    let compare snk1 snk2 = match snk1, snk2 with
+    let compare snk1 snk2 = tags_compare snk1 snk2
-      | ShellExec, ShellExec -> 0
-      | ShellExec, _ -> (-1)
-      | _, ShellExec -> 1
-      | Other, Other -> 0
   end
 
   type kind = SinkKind.t

infer/src/quandary/JavaTrace.ml

@@ -22,16 +22,8 @@ module JavaSource = struct
       | Other (** for testing or uncategorized sources *)
 
     let compare sk1 sk2 = match sk1, sk2 with
-      | SharedPreferences, SharedPreferences -> 0
-      | SharedPreferences, _ -> (-1)
-      | _, SharedPreferences -> 1
       | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2
-      | Footprint _, _ -> (-1)
+      | _ -> tags_compare sk1 sk2
-      | _, Footprint _ -> 1
-      | Intent, Intent -> 0
-      | Intent, _ -> (-1)
-      | _, Intent -> 1
-      | Other, Other -> 0
   end
 
   type kind = SourceKind.t
@@ -109,14 +101,7 @@ module JavaSink = struct
       | Logging (** sink that logs one or more of its arguments *)
       | Other (** for testing or uncategorized sinks *)
 
-    let compare snk1 snk2 = match snk1, snk2 with
+    let compare snk1 snk2 = tags_compare snk1 snk2
-      | Logging, Logging -> 0
-      | Logging, _ -> (-1)
-      | _, Logging -> 1
-      | Intent, Intent -> 0
-      | Intent, _ -> (-1)
-      | _, Intent -> 1
-      | Other, Other -> 0
   end
 
   type kind = SinkKind.t