mk_find_duplicate_nodes: better code

Reviewed By: jeremydubreil

Differential Revision: D8153616

fbshipit-source-id: d0256b1
master
Mehdi Bouaziz 7 years ago committed by Facebook Github Bot
parent c9b79039f9
commit c84bf5959b

@ -187,6 +187,9 @@ val iter_instrs : (Node.t -> Sil.instr -> unit) -> t -> unit
val iter_nodes : (Node.t -> unit) -> t -> unit val iter_nodes : (Node.t -> unit) -> t -> unit
(** iterate over all the nodes of a procedure *) (** iterate over all the nodes of a procedure *)
val fold_nodes : t -> init:'accum -> f:('accum -> Node.t -> 'accum) -> 'accum
(** fold over all the nodes of a procedure *)
val fold_slope_range : Node.t -> Node.t -> init:'accum -> f:('accum -> Node.t -> 'accum) -> 'accum val fold_slope_range : Node.t -> Node.t -> init:'accum -> f:('accum -> Node.t -> 'accum) -> 'accum
(** fold between two nodes or until we reach a branching structure *) (** fold between two nodes or until we reach a branching structure *)

@ -141,8 +141,8 @@ let node_key node =
(** normalize the list of instructions by renaming let-bound ids *) (** normalize the list of instructions by renaming let-bound ids *)
let instrs_normalize instrs = let instrs_normalize instrs =
let bound_ids = let bound_ids =
let do_instr ids = function Sil.Load (id, _, _, _) -> id :: ids | _ -> ids in let do_instr = function Sil.Load (id, _, _, _) -> Some id | _ -> None in
List.fold ~f:do_instr ~init:[] instrs List.rev_filter_map instrs ~f:do_instr
in in
let subst = let subst =
let count = ref Int.min_value in let count = ref Int.min_value in
@ -150,72 +150,56 @@ let instrs_normalize instrs =
incr count ; incr count ;
Ident.set_stamp id !count Ident.set_stamp id !count
in in
Sil.subst_of_list (List.map ~f:(fun id -> (id, Exp.Var (gensym id))) bound_ids) Sil.subst_of_list (List.rev_map ~f:(fun id -> (id, Exp.Var (gensym id))) bound_ids)
in in
List.map ~f:(Sil.instr_sub subst) instrs List.rev_map ~f:(Sil.instr_sub subst) instrs
(** Create a function to find duplicate nodes. (** Create a function to find duplicate nodes.
A node is a duplicate of another one if they have the same kind and location A node is a duplicate of another one if they have the same kind and location
and normalized (w.r.t. renaming of let - bound ids) list of instructions. *) and normalized (w.r.t. renaming of let - bound ids) list of instructions. *)
let mk_find_duplicate_nodes proc_desc : Procdesc.Node.t -> Procdesc.NodeSet.t = let mk_find_duplicate_nodes : Procdesc.t -> Procdesc.Node.t -> Procdesc.NodeSet.t =
let module M = (* map from (loc,kind) *) let module M = (* map from (loc,kind) *)
Caml.Map.Make (struct Caml.Map.Make (struct
type t = Location.t * Procdesc.Node.nodekind [@@deriving compare] type t = Location.t * Procdesc.Node.nodekind [@@deriving compare]
end) in end) in
let module S = (* set of nodes with normalized insructions *) let module E = struct
Caml.Set.Make (struct (** Threshold: do not build the map if too many nodes are duplicates. *)
type t = Procdesc.Node.t * Sil.instr list let threshold = 100
let compare (n1, _) (n2, _) = Procdesc.Node.compare n1 n2 exception Threshold
end) in end in
let get_key node = let get_key node =
(* map key *) (* map key *)
let loc = Procdesc.Node.get_loc node in let loc = Procdesc.Node.get_loc node in
let kind = Procdesc.Node.get_kind node in let kind = Procdesc.Node.get_kind node in
(loc, kind) (loc, kind)
in in
fun proc_desc ->
let map = let map =
let m = ref M.empty in (* map from (loc, kind) to (node -> instructions) map *)
(* map from (loc, kind) to (instructions, node) set *) let do_node m node =
let module E = struct
(** Threshold: do not build the map if too many nodes are duplicates. *)
let threshold = 100
exception Threshold
end in
let do_node node =
let normalized_instrs = instrs_normalize (Procdesc.Node.get_instrs node) in let normalized_instrs = instrs_normalize (Procdesc.Node.get_instrs node) in
let key = get_key node in let key = get_key node in
let s = try M.find key !m with Caml.Not_found -> S.empty in M.update key
if S.cardinal s > E.threshold then raise E.Threshold ; (fun s_opt ->
let s' = S.add (node, normalized_instrs) s in let s = Option.value s_opt ~default:Procdesc.NodeMap.empty in
m := M.add key s' !m if Procdesc.NodeMap.cardinal s > E.threshold then raise E.Threshold ;
Some (Procdesc.NodeMap.add node normalized_instrs s) )
m
in in
let nodes = Procdesc.get_nodes proc_desc in try Procdesc.fold_nodes proc_desc ~init:M.empty ~f:do_node with E.Threshold -> M.empty
try List.iter ~f:do_node nodes ; !m with E.Threshold -> M.empty
in in
let find_duplicate_nodes node = let find_duplicate_nodes node =
try try
let s = M.find (get_key node) map in let s = M.find (get_key node) map in
let elements = S.elements s in let node_normalized_instrs = Procdesc.NodeMap.find node s in
let (_, node_normalized_instrs), _ = let collect_duplicates node' normalized_instrs' nset =
let filter (node', _) = Procdesc.Node.equal node node' in if List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' then
match List.partition_tf ~f:filter elements with Procdesc.NodeSet.add node' nset
| [this], others -> else nset
(this, others)
| _ ->
raise Caml.Not_found
in
let duplicates =
let equal_normalized_instrs (_, normalized_instrs') =
List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs'
in
List.filter ~f:equal_normalized_instrs elements
in in
List.fold Procdesc.NodeMap.fold collect_duplicates s Procdesc.NodeSet.empty
~f:(fun nset (node', _) -> Procdesc.NodeSet.add node' nset)
~init:Procdesc.NodeSet.empty duplicates
with Caml.Not_found -> Procdesc.NodeSet.singleton node with Caml.Not_found -> Procdesc.NodeSet.singleton node
in in
find_duplicate_nodes find_duplicate_nodes

Loading…
Cancel
Save