ppx_compare Exp

Reviewed By: cristianoc

Differential Revision: D4232392

fbshipit-source-id: 930d2ea

infer/src/IR/Exp.re

@@ -18,13 +18,18 @@ let module L = Logging;
 
 let module F = Format;
 
-type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)}
+/* reverse the natural order on Var */
+type _ident = Ident.t;
+
+let compare__ident x y => Ident.compare y x;
+
+type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} [@@deriving compare]
 /** dynamically determined length of an array value, if any */
-and dynamic_length = option t
+and dynamic_length = option t [@@deriving compare]
 /** Program expressions. */
 and t =
   /** Pure variable: it is not an lvalue */
-  | Var Ident.t
+  | Var _ident
   /** Unary operator with type of the result if known */
   | UnOp Unop.t t (option Typ.t)
   /** Binary operator */
@@ -50,121 +55,6 @@ and t =
       the [dynamic_length] is that of the final extensible array, if any. */
   | Sizeof Typ.t dynamic_length Subtype.t;
 
-
-/** Compare expressions. Variables come before other expressions. */
-let rec compare e1 e2 =>
-  switch (e1, e2) {
-  | (Var id1, Var id2) => Ident.compare id2 id1
-  | (Var _, _) => (-1)
-  | (_, Var _) => 1
-  | (UnOp o1 e1 to1, UnOp o2 e2 to2) =>
-    let n = Unop.compare o1 o2;
-    if (n != 0) {
-      n
-    } else {
-      let n = compare e1 e2;
-      if (n != 0) {
-        n
-      } else {
-        opt_compare Typ.compare to1 to2
-      }
-    }
-  | (UnOp _, _) => (-1)
-  | (_, UnOp _) => 1
-  | (BinOp o1 e1 f1, BinOp o2 e2 f2) =>
-    let n = Binop.compare o1 o2;
-    if (n != 0) {
-      n
-    } else {
-      let n = compare e1 e2;
-      if (n != 0) {
-        n
-      } else {
-        compare f1 f2
-      }
-    }
-  | (BinOp _, _) => (-1)
-  | (_, BinOp _) => 1
-  | (Exn e1, Exn e2) => compare e1 e2
-  | (Exn _, _) => (-1)
-  | (_, Exn _) => 1
-  | (Closure {name: n1, captured_vars: c1}, Closure {name: n2, captured_vars: c2}) =>
-    let captured_var_compare acc (e1, pvar1, typ1) (e2, pvar2, typ2) =>
-      if (acc != 0) {
-        acc
-      } else {
-        let n = compare e1 e2;
-        if (n != 0) {
-          n
-        } else {
-          let n = Pvar.compare pvar1 pvar2;
-          if (n != 0) {
-            n
-          } else {
-            Typ.compare typ1 typ2
-          }
-        }
-      };
-    let n = Procname.compare n1 n2;
-    if (n != 0) {
-      n
-    } else {
-      IList.fold_left2 captured_var_compare 0 c1 c2
-    }
-  | (Closure _, _) => (-1)
-  | (_, Closure _) => 1
-  | (Const c1, Const c2) => Const.compare c1 c2
-  | (Const _, _) => (-1)
-  | (_, Const _) => 1
-  | (Cast t1 e1, Cast t2 e2) =>
-    let n = Typ.compare t1 t2;
-    if (n != 0) {
-      n
-    } else {
-      compare e1 e2
-    }
-  | (Cast _, _) => (-1)
-  | (_, Cast _) => 1
-  | (Lvar i1, Lvar i2) => Pvar.compare i1 i2
-  | (Lvar _, _) => (-1)
-  | (_, Lvar _) => 1
-  | (Lfield e1 f1 t1, Lfield e2 f2 t2) =>
-    let n = compare e1 e2;
-    if (n != 0) {
-      n
-    } else {
-      let n = Ident.compare_fieldname f1 f2;
-      if (n != 0) {
-        n
-      } else {
-        Typ.compare t1 t2
-      }
-    }
-  | (Lfield _, _) => (-1)
-  | (_, Lfield _) => 1
-  | (Lindex e1 f1, Lindex e2 f2) =>
-    let n = compare e1 e2;
-    if (n != 0) {
-      n
-    } else {
-      compare f1 f2
-    }
-  | (Lindex _, _) => (-1)
-  | (_, Lindex _) => 1
-  | (Sizeof t1 l1 s1, Sizeof t2 l2 s2) =>
-    let n = Typ.compare t1 t2;
-    if (n != 0) {
-      n
-    } else {
-      let n = opt_compare compare l1 l2;
-      if (n != 0) {
-        n
-      } else {
-        Subtype.compare s1 s2
-      }
-    }
-  };
-
 let equal e1 e2 => compare e1 e2 == 0;
 
 let hash = Hashtbl.hash;

infer/src/IR/Exp.rei

@@ -18,9 +18,9 @@ let module L = Logging;
 
 let module F = Format;
 
-type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)}
+type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} [@@deriving compare]
 /** dynamically determined length of an array value, if any */
-and dynamic_length = option t
+and dynamic_length = option t [@@deriving compare]
 /** Program expressions. */
 and t =
   /** Pure variable: it is not an lvalue */
@@ -48,11 +48,8 @@ and t =
       The [dynamic_length], tracked by symbolic execution, may differ from the [static_length]
       obtained from the type definition, e.g. when an array is over-allocated.  For struct types,
       the [dynamic_length] is that of the final extensible array, if any. */
-  | Sizeof Typ.t dynamic_length Subtype.t;
+  | Sizeof Typ.t dynamic_length Subtype.t
-
+[@@deriving compare];
-
-/** Comparison for expressions. */
-let compare: t => t => int;
 
 
 /** Equality for expressions. */