ppx_compare Procdesc

Reviewed By: sblackshear

Differential Revision: D4232402

fbshipit-source-id: 49ae1de

infer/src/IR/Procdesc.re

@@ -25,7 +25,8 @@ let module Node = {
     | Stmt_node string
     | Join_node
     | Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
-    | Skip_node string;
+    | Skip_node string
+  [@@deriving compare];
 
   /** a node */
   type t = {
@@ -70,7 +71,7 @@ let module Node = {
   let get_id node => node.id;
 
   /** compare node ids */
-  let id_compare = int_compare;
+  let compare_id = int_compare;
   let get_succs node => node.succs;
   type node = t;
   let module NodeSet = Set.Make {
@@ -79,7 +80,7 @@ let module Node = {
   };
   let module IdMap = Map.Make {
     type t = id;
-    let compare = id_compare;
+    let compare = compare_id;
   };
   let get_sliced_succs node f => {
     let visited = ref NodeSet.empty;
@@ -145,38 +146,6 @@ let module Node = {
   /** Get the node kind */
   let get_kind node => node.kind;
 
-  /** Comparison for node kind */
-  let kind_compare k1 k2 =>
-    switch (k1, k2) {
-    | (Start_node pn1, Start_node pn2) => Procname.compare pn1 pn2
-    | (Start_node _, _) => (-1)
-    | (_, Start_node _) => 1
-    | (Exit_node pn1, Exit_node pn2) => Procname.compare pn1 pn2
-    | (Exit_node _, _) => (-1)
-    | (_, Exit_node _) => 1
-    | (Stmt_node s1, Stmt_node s2) => string_compare s1 s2
-    | (Stmt_node _, _) => (-1)
-    | (_, Stmt_node _) => 1
-    | (Join_node, Join_node) => 0
-    | (Join_node, _) => (-1)
-    | (_, Join_node) => 1
-    | (Prune_node is_true_branch1 if_kind1 descr1, Prune_node is_true_branch2 if_kind2 descr2) =>
-      let n = bool_compare is_true_branch1 is_true_branch2;
-      if (n != 0) {
-        n
-      } else {
-        let n = Pervasives.compare if_kind1 if_kind2;
-        if (n != 0) {
-          n
-        } else {
-          string_compare descr1 descr2
-        }
-      }
-    | (Prune_node _, _) => (-1)
-    | (_, Prune_node _) => 1
-    | (Skip_node s1, Skip_node s2) => string_compare s1 s2
-    };
-
   /** Get the instructions to be executed */
   let get_instrs node => node.instrs;
 

infer/src/IR/Procdesc.rei

@@ -17,10 +17,10 @@ open! Utils;
 let module Node: {
 
   /** type of nodes */
-  type t;
+  type t [@@deriving compare];
 
   /** node id */
-  type id = private int;
+  type id = private int [@@deriving compare];
 
   /** kind of cfg node */
   type nodekind =
@@ -29,7 +29,8 @@ let module Node: {
     | Stmt_node string
     | Join_node
     | Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
-    | Skip_node string;
+    | Skip_node string
+  [@@deriving compare];
 
   /** kind of Stmt_node for an exception handler. */
   let exn_handler_kind: nodekind;
@@ -46,9 +47,6 @@ let module Node: {
   /** Append the instructions to the list of instructions to execute */
   let append_instrs: t => list Sil.instr => unit;
 
-  /** Compare two nodes */
-  let compare: t => t => int;
-
   /** Dump extended instructions for the node */
   let d_instrs: sub_instrs::bool => option Sil.instr => t => unit;
 
@@ -107,12 +105,6 @@ let module Node: {
   /** Hash function for nodes */
   let hash: t => int;
 
-  /** compare node ids */
-  let id_compare: id => id => int;
-
-  /** Comparison for node kind */
-  let kind_compare: nodekind => nodekind => int;
-
   /** Pretty print the node */
   let pp: Format.formatter => t => unit;
 

infer/src/backend/specs.ml

@@ -144,7 +144,7 @@ end
 module Visitedset =
   Set.Make (struct
     type t = Procdesc.Node.id * int list
-    let compare (node_id1, _) (node_id2, _) = Procdesc.Node.id_compare node_id1 node_id2
+    let compare (node_id1, _) (node_id2, _) = Procdesc.Node.compare_id node_id1 node_id2
   end)
 
 let visited_str vis =

infer/src/backend/state.ml

@@ -167,7 +167,7 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t)
       type t = Location.t * Procdesc.Node.nodekind
       let compare (loc1, k1) (loc2, k2) =
         let n = Location.compare loc1 loc2 in
-        if n <> 0 then n else Procdesc.Node.kind_compare k1 k2
+        if n <> 0 then n else Procdesc.Node.compare_nodekind k1 k2
     end) in
 
   let module S = (* set of nodes with normalized insructions *)

infer/src/checkers/SimpleChecker.ml

@@ -97,7 +97,7 @@ module Make (Spec : Spec) : S = struct
         (* should never fail since keys in the invariant map should always be real node id's *)
         let node =
           IList.find
-            (fun node -> Procdesc.Node.id_compare node_id (Procdesc.Node.get_id node) = 0)
+            (fun node -> Procdesc.Node.compare_id node_id (Procdesc.Node.get_id node) = 0)
             nodes in
         Domain.iter
           (fun astate ->

infer/src/checkers/procCfg.ml

@@ -37,7 +37,7 @@ module DefaultNode = struct
   let id = Procdesc.Node.get_id
   let loc = Procdesc.Node.get_loc
   let underlying_id = id
-  let id_compare = Procdesc.Node.id_compare
+  let id_compare = Procdesc.Node.compare_id
   let pp_id = Procdesc.Node.pp_id
 end
 
@@ -60,7 +60,7 @@ module InstrNode = struct
     | Instr_index _, Node_index -> -1
 
   let id_compare (id1, index1) (id2, index2) =
-    let n = Procdesc.Node.id_compare id1 id2 in
+    let n = Procdesc.Node.compare_id id1 id2 in
     if n <> 0 then n
     else index_compare index1 index2