Summary: They were constructed for each source file, and then joined into a global call graph, only to get per-file lists of procedures. A tad wasteful. Get this list from cfgs instead. Still record them in `exe_env` for now as changing that code is a whole other beast. One test falls victim of the flakiness of the analysis of recursive functions. Reviewed By: jeremydubreil, mbouaziz Differential Revision: D6324268 fbshipit-source-id: d5ff58fmaster
Jules Villard
7 years ago
committed by
Facebook Github Bot
parent
f2029af50a
commit
daa5154399
@ -1,281 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2009 - 2013 Monoidics ltd.
|
||||
* Copyright (c) 2013 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
(** Module for call graphs *)
|
||||
|
||||
open! IStd
|
||||
module Hashtbl = Caml.Hashtbl
|
||||
module L = Logging
|
||||
module F = Format
|
||||
|
||||
type node = Typ.Procname.t
|
||||
|
||||
type in_out_calls =
|
||||
{ in_calls: int (** total number of in calls transitively *)
|
||||
; out_calls: int (** total number of out calls transitively *) }
|
||||
|
||||
type node_info =
|
||||
{ mutable defined: bool (** defined procedure as opposed to just declared *)
|
||||
; mutable parents: Typ.Procname.Set.t
|
||||
; mutable children: Typ.Procname.Set.t
|
||||
; mutable ancestors: Typ.Procname.Set.t option (** ancestors are computed lazily *)
|
||||
; mutable heirs: Typ.Procname.Set.t option (** heirs are computed lazily *)
|
||||
; mutable recursive_dependents: Typ.Procname.Set.t option
|
||||
(** recursive dependents are computed lazily *)
|
||||
; mutable in_out_calls: in_out_calls option (** calls are computed lazily *) }
|
||||
|
||||
(** Type for call graph *)
|
||||
type t =
|
||||
{ source: SourceFile.t (** path for the source file *)
|
||||
; node_map: node_info Typ.Procname.Hash.t (** map from node to node_info *) }
|
||||
|
||||
let create source = {source; node_map= Typ.Procname.Hash.create 3}
|
||||
|
||||
let add_node g n ~defined =
|
||||
try
|
||||
let info = Typ.Procname.Hash.find g.node_map n in
|
||||
(* defined and disabled only go from false to true
|
||||
to avoid accidental overwrite to false by calling add_edge *)
|
||||
if defined then info.defined <- true
|
||||
with Not_found ->
|
||||
let info =
|
||||
{ defined
|
||||
; parents= Typ.Procname.Set.empty
|
||||
; children= Typ.Procname.Set.empty
|
||||
; ancestors= None
|
||||
; heirs= None
|
||||
; recursive_dependents= None
|
||||
; in_out_calls= None }
|
||||
in
|
||||
Typ.Procname.Hash.add g.node_map n info
|
||||
|
||||
|
||||
let remove_node_defined g n =
|
||||
try
|
||||
let info = Typ.Procname.Hash.find g.node_map n in
|
||||
info.defined <- false
|
||||
with Not_found -> ()
|
||||
|
||||
|
||||
let add_defined_node g n = add_node g n ~defined:true
|
||||
|
||||
(** Compute the ancestors of the node, if not already computed *)
|
||||
let compute_ancestors g node =
|
||||
let todo = ref (Typ.Procname.Set.singleton node) in
|
||||
let seen = ref Typ.Procname.Set.empty in
|
||||
let result = ref Typ.Procname.Set.empty in
|
||||
while not (Typ.Procname.Set.is_empty !todo) do
|
||||
let current = Typ.Procname.Set.choose !todo in
|
||||
todo := Typ.Procname.Set.remove current !todo ;
|
||||
if not (Typ.Procname.Set.mem current !seen) then (
|
||||
seen := Typ.Procname.Set.add current !seen ;
|
||||
let info = Typ.Procname.Hash.find g current in
|
||||
match info.ancestors with
|
||||
| Some ancestors ->
|
||||
result := Typ.Procname.Set.union !result ancestors
|
||||
| None ->
|
||||
result := Typ.Procname.Set.union !result info.parents ;
|
||||
todo := Typ.Procname.Set.union !todo info.parents )
|
||||
done ;
|
||||
!result
|
||||
|
||||
|
||||
(** Compute the heirs of the node, if not already computed *)
|
||||
let compute_heirs g node =
|
||||
let todo = ref (Typ.Procname.Set.singleton node) in
|
||||
let seen = ref Typ.Procname.Set.empty in
|
||||
let result = ref Typ.Procname.Set.empty in
|
||||
while not (Typ.Procname.Set.is_empty !todo) do
|
||||
let current = Typ.Procname.Set.choose !todo in
|
||||
todo := Typ.Procname.Set.remove current !todo ;
|
||||
if not (Typ.Procname.Set.mem current !seen) then (
|
||||
seen := Typ.Procname.Set.add current !seen ;
|
||||
let info = Typ.Procname.Hash.find g current in
|
||||
match info.heirs with
|
||||
| Some heirs ->
|
||||
result := Typ.Procname.Set.union !result heirs
|
||||
| None ->
|
||||
result := Typ.Procname.Set.union !result info.children ;
|
||||
todo := Typ.Procname.Set.union !todo info.children )
|
||||
done ;
|
||||
!result
|
||||
|
||||
|
||||
(** Compute the ancestors of the node, if not pre-computed already *)
|
||||
let get_ancestors (g: t) node =
|
||||
let info = Typ.Procname.Hash.find g.node_map node in
|
||||
match info.ancestors with
|
||||
| None ->
|
||||
let ancestors = compute_ancestors g.node_map node in
|
||||
info.ancestors <- Some ancestors ;
|
||||
let size = Typ.Procname.Set.cardinal ancestors in
|
||||
if size > 1000 then
|
||||
L.(debug Analysis Medium) "%a has %d ancestors@." Typ.Procname.pp node size ;
|
||||
ancestors
|
||||
| Some ancestors ->
|
||||
ancestors
|
||||
|
||||
|
||||
(** Compute the heirs of the node, if not pre-computed already *)
|
||||
let get_heirs (g: t) node =
|
||||
let info = Typ.Procname.Hash.find g.node_map node in
|
||||
match info.heirs with
|
||||
| None ->
|
||||
let heirs = compute_heirs g.node_map node in
|
||||
info.heirs <- Some heirs ;
|
||||
let size = Typ.Procname.Set.cardinal heirs in
|
||||
if size > 1000 then L.(debug Analysis Medium) "%a has %d heirs@." Typ.Procname.pp node size ;
|
||||
heirs
|
||||
| Some heirs ->
|
||||
heirs
|
||||
|
||||
|
||||
let node_defined (g: t) n =
|
||||
try
|
||||
let info = Typ.Procname.Hash.find g.node_map n in
|
||||
info.defined
|
||||
with Not_found -> false
|
||||
|
||||
|
||||
let add_edge g nfrom nto =
|
||||
add_node g nfrom ~defined:false ;
|
||||
add_node g nto ~defined:false ;
|
||||
let info_from = Typ.Procname.Hash.find g.node_map nfrom in
|
||||
let info_to = Typ.Procname.Hash.find g.node_map nto in
|
||||
info_from.children <- Typ.Procname.Set.add nto info_from.children ;
|
||||
info_to.parents <- Typ.Procname.Set.add nfrom info_to.parents
|
||||
|
||||
|
||||
(** iterate over the elements of a node_map in node order *)
|
||||
let node_map_iter f g =
|
||||
let table = ref [] in
|
||||
Typ.Procname.Hash.iter (fun node info -> table := (node, info) :: !table) g.node_map ;
|
||||
let cmp ((n1: Typ.Procname.t), _) ((n2: Typ.Procname.t), _) = Typ.Procname.compare n1 n2 in
|
||||
List.iter ~f:(fun (n, info) -> f n info) (List.sort ~cmp !table)
|
||||
|
||||
|
||||
let get_nodes (g: t) =
|
||||
let nodes = ref Typ.Procname.Set.empty in
|
||||
let f node _ = nodes := Typ.Procname.Set.add node !nodes in
|
||||
node_map_iter f g ; !nodes
|
||||
|
||||
|
||||
let compute_calls g node =
|
||||
{ in_calls= Typ.Procname.Set.cardinal (get_ancestors g node)
|
||||
; out_calls= Typ.Procname.Set.cardinal (get_heirs g node) }
|
||||
|
||||
|
||||
(** Compute the calls of the node, if not pre-computed already *)
|
||||
let get_calls (g: t) node =
|
||||
let info = Typ.Procname.Hash.find g.node_map node in
|
||||
match info.in_out_calls with
|
||||
| None ->
|
||||
let calls = compute_calls g node in
|
||||
info.in_out_calls <- Some calls ;
|
||||
calls
|
||||
| Some calls ->
|
||||
calls
|
||||
|
||||
|
||||
let get_all_nodes (g: t) =
|
||||
let nodes = Typ.Procname.Set.elements (get_nodes g) in
|
||||
List.map ~f:(fun node -> (node, get_calls g node)) nodes
|
||||
|
||||
|
||||
let node_get_num_ancestors g n = (n, Typ.Procname.Set.cardinal (get_ancestors g n))
|
||||
|
||||
let get_edges (g: t) : ((node * int) * (node * int)) list =
|
||||
let edges = ref [] in
|
||||
let f node info =
|
||||
Typ.Procname.Set.iter
|
||||
(fun nto -> edges := (node_get_num_ancestors g node, node_get_num_ancestors g nto) :: !edges)
|
||||
info.children
|
||||
in
|
||||
node_map_iter f g ; !edges
|
||||
|
||||
|
||||
(** nodes with defined flag, and edges *)
|
||||
type nodes_and_edges = (node * bool) list * (node * node) list
|
||||
|
||||
(** Return the list of nodes, with defined+disabled flags, and the list of edges *)
|
||||
let get_nodes_and_edges (g: t) : nodes_and_edges =
|
||||
let nodes = ref [] in
|
||||
let edges = ref [] in
|
||||
let do_children node nto = edges := (node, nto) :: !edges in
|
||||
let f node info =
|
||||
nodes := (node, info.defined) :: !nodes ;
|
||||
Typ.Procname.Set.iter (do_children node) info.children
|
||||
in
|
||||
node_map_iter f g ; (!nodes, !edges)
|
||||
|
||||
|
||||
(** Return the list of nodes which are defined *)
|
||||
let get_defined_nodes (g: t) =
|
||||
let nodes, _ = get_nodes_and_edges g in
|
||||
let get_node (node, _) = node in
|
||||
List.map ~f:get_node (List.filter ~f:(fun (_, defined) -> defined) nodes)
|
||||
|
||||
|
||||
(** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
|
||||
undefined nodes become defined if at least one side is. *)
|
||||
let extend cg_old cg_new =
|
||||
let nodes, edges = get_nodes_and_edges cg_new in
|
||||
List.iter ~f:(fun (node, defined) -> add_node cg_old node ~defined) nodes ;
|
||||
List.iter ~f:(fun (nfrom, nto) -> add_edge cg_old nfrom nto) edges
|
||||
|
||||
|
||||
(** Begin support for serialization *)
|
||||
let callgraph_serializer : (SourceFile.t * nodes_and_edges) Serialization.serializer =
|
||||
Serialization.create_serializer Serialization.Key.cg
|
||||
|
||||
|
||||
(** Load a call graph from a file *)
|
||||
let load_from_file (filename: DB.filename) : t option =
|
||||
match Serialization.read_from_file callgraph_serializer filename with
|
||||
| None ->
|
||||
None
|
||||
| Some (source, (nodes, edges)) ->
|
||||
let g = create source in
|
||||
List.iter ~f:(fun (node, defined) -> if defined then add_defined_node g node) nodes ;
|
||||
List.iter ~f:(fun (nfrom, nto) -> add_edge g nfrom nto) edges ;
|
||||
Some g
|
||||
|
||||
|
||||
(** Save a call graph into a file *)
|
||||
let store_to_file (filename: DB.filename) (call_graph: t) =
|
||||
Serialization.write_to_file callgraph_serializer filename
|
||||
~data:(call_graph.source, get_nodes_and_edges call_graph)
|
||||
|
||||
|
||||
let pp_graph_dotty (g: t) fmt =
|
||||
let nodes_with_calls = get_all_nodes g in
|
||||
let get_shape (n, _) = if node_defined g n then "box" else "diamond" in
|
||||
let pp_node fmt (n, _) = F.fprintf fmt "\"%s\"" (Typ.Procname.to_filename n) in
|
||||
let pp_node_label fmt (n, calls) =
|
||||
F.fprintf fmt "\"%a | calls=%d %d)\"" Typ.Procname.pp n calls.in_calls calls.out_calls
|
||||
in
|
||||
F.fprintf fmt "digraph {@\n" ;
|
||||
List.iter
|
||||
~f:(fun nc ->
|
||||
F.fprintf fmt "%a [shape=box,label=%a,color=%s,shape=%s]@\n" pp_node nc pp_node_label nc
|
||||
"red" (get_shape nc) )
|
||||
nodes_with_calls ;
|
||||
List.iter ~f:(fun (s, d) -> F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g) ;
|
||||
F.fprintf fmt "}@."
|
||||
|
||||
|
||||
(** Print the call graph as a dotty file. *)
|
||||
let save_call_graph_dotty source (g: t) =
|
||||
let fname_dot =
|
||||
DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) ["call_graph.dot"]
|
||||
in
|
||||
let outc = Out_channel.create (DB.filename_to_string fname_dot) in
|
||||
let fmt = F.formatter_of_out_channel outc in
|
||||
pp_graph_dotty g fmt ; Out_channel.close outc
|
||||
@ -1,52 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2009 - 2013 Monoidics ltd.
|
||||
* Copyright (c) 2013 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
(** Module for call graphs *)
|
||||
|
||||
(** the type of a call graph *)
|
||||
type t
|
||||
|
||||
(** A call graph consists of a set of nodes (Typ.Procname.t), and edges between them.
|
||||
A node can be defined or undefined (to represent whether we have code for it).
|
||||
In an edge from [n1] to [n2], indicating that [n1] calls [n2],
|
||||
[n1] is the parent and [n2] is the child.
|
||||
Node [n1] is dependent on [n2] if there is a path from [n1] to [n2]
|
||||
using the child relationship. *)
|
||||
|
||||
val add_edge : t -> Typ.Procname.t -> Typ.Procname.t -> unit
|
||||
(** [add_edge cg f t] adds an edge from [f] to [t] in the call graph [cg].
|
||||
The nodes are also added as undefined, unless already present. *)
|
||||
|
||||
val add_defined_node : t -> Typ.Procname.t -> unit
|
||||
(** Add a node to the call graph as defined *)
|
||||
|
||||
val create : SourceFile.t -> t
|
||||
(** Create an empty call graph *)
|
||||
|
||||
val extend : t -> t -> unit
|
||||
(** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2];
|
||||
undefined nodes become defined if at least one side is. *)
|
||||
|
||||
val get_defined_nodes : t -> Typ.Procname.t list
|
||||
(** Return the list of nodes which are defined *)
|
||||
|
||||
val load_from_file : DB.filename -> t option
|
||||
(** Load a call graph from a file *)
|
||||
|
||||
val remove_node_defined : t -> Typ.Procname.t -> unit
|
||||
(** Remove the defined flag from a node, if it exists. *)
|
||||
|
||||
val save_call_graph_dotty : SourceFile.t -> t -> unit
|
||||
(** Print the call graph as a dotty file. *)
|
||||
|
||||
val store_to_file : DB.filename -> t -> unit
|
||||
(** Save a call graph into a file *)
|
||||
Loading…
Reference in new issue