From b94b5f1c586bc5a914dbc5b344da332016a64a2c Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 29 Nov 2016 16:39:31 -0800 Subject: [PATCH] ppx_compare Procdesc Reviewed By: sblackshear Differential Revision: D4232402 fbshipit-source-id: 49ae1de --- infer/src/IR/Procdesc.re | 39 +++-------------------------- infer/src/IR/Procdesc.rei | 16 +++--------- infer/src/backend/specs.ml | 2 +- infer/src/backend/state.ml | 2 +- infer/src/checkers/SimpleChecker.ml | 2 +- infer/src/checkers/procCfg.ml | 4 +-- 6 files changed, 13 insertions(+), 52 deletions(-) diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index 238f0e839..3810b7d7c 100644 --- a/infer/src/IR/Procdesc.re +++ b/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; diff --git a/infer/src/IR/Procdesc.rei b/infer/src/IR/Procdesc.rei index c480153fa..bfb5ddee4 100644 --- a/infer/src/IR/Procdesc.rei +++ b/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; diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index ddfb843c2..23f1c331d 100644 --- a/infer/src/backend/specs.ml +++ b/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 = diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index 1eab0a550..59dc74e35 100644 --- a/infer/src/backend/state.ml +++ b/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 *) diff --git a/infer/src/checkers/SimpleChecker.ml b/infer/src/checkers/SimpleChecker.ml index 283823c02..bc5b9547c 100644 --- a/infer/src/checkers/SimpleChecker.ml +++ b/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 -> diff --git a/infer/src/checkers/procCfg.ml b/infer/src/checkers/procCfg.ml index 6b08055ad..d1398f946 100644 --- a/infer/src/checkers/procCfg.ml +++ b/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