Add function to add an edge to the call graph

Summary: The reverse call graph will be constructed by adding edges one-by-one, so expose functionality in CallGraph to add a single edge to the graph

Reviewed By: jvillard

Differential Revision: D16285016

fbshipit-source-id: 553fe1ecf

infer/src/backend/CallGraph.ml

@@ -8,10 +8,13 @@ open! IStd
 module F = Format
 
 module type NodeSig = sig
-  type t = private {id: int; pname: Typ.Procname.t; successors: int list; mutable flag: bool}
+  type t = private
+    {id: int; pname: Typ.Procname.t; mutable successors: int list; mutable flag: bool}
 
   val make : int -> Typ.Procname.t -> int list -> t
 
+  val add_successor : t -> int -> unit
+
   val set_flag : t -> unit
 
   val unset_flag : t -> unit
@@ -20,10 +23,12 @@ module type NodeSig = sig
 end
 
 module Node : NodeSig = struct
-  type t = {id: int; pname: Typ.Procname.t; successors: int list; mutable flag: bool}
+  type t = {id: int; pname: Typ.Procname.t; mutable successors: int list; mutable flag: bool}
 
   let make id pname successors = {id; pname; successors; flag= false}
 
+  let add_successor node successor = node.successors <- successor :: node.successors
+
   let set_flag n = n.flag <- true
 
   let unset_flag n = n.flag <- false
@@ -64,21 +69,40 @@ let node_of_procname g pname = id_of_procname g pname |> Option.bind ~f:(node_of
 
 let remove (g : t) pname id = IdMap.remove g.id_map pname ; NodeMap.remove g.node_map id
 
-let add ({id_map; node_map} as graph) pname successor_pnames =
-  let get_or_set_id procname =
-    match id_of_procname graph procname with
-    | None ->
-        let id = IdMap.length id_map in
-        IdMap.replace id_map procname id ; id
-    | Some id ->
-        id
-  in
-  let id = get_or_set_id pname in
-  let successors = List.map successor_pnames ~f:get_or_set_id in
+let get_or_set_id ({id_map} as graph) procname =
+  match id_of_procname graph procname with
+  | None ->
+      let id = IdMap.length id_map in
+      IdMap.replace id_map procname id ; id
+  | Some id ->
+      id
+
+
+let create_node ({node_map} as graph) pname successor_pnames =
+  let id = get_or_set_id graph pname in
+  let successors = List.map successor_pnames ~f:(get_or_set_id graph) in
   let node = Node.make id pname successors in
   NodeMap.replace node_map id node
 
 
+let get_or_init_node node_map id pname =
+  match NodeMap.find_opt node_map id with
+  | Some node ->
+      node
+  | None ->
+      let new_node = Node.make id pname [] in
+      NodeMap.add node_map id new_node ; new_node
+
+
+let add_edge ({node_map} as graph) ~pname ~successor_pname =
+  let id = get_or_set_id graph pname in
+  let successor = get_or_set_id graph successor_pname in
+  let node = get_or_init_node node_map id pname in
+  (* initialize successor node if it isn't already initalized *)
+  get_or_init_node node_map successor successor_pname |> ignore ;
+  Node.add_successor node successor
+
+
 let remove_reachable g start_pname =
   let add_live_successors_and_remove_self init (n : Node.t) =
     remove g n.pname n.id ;

infer/src/backend/CallGraph.mli

@@ -8,10 +8,13 @@ open! IStd
 module F = Format
 
 module type NodeSig = sig
-  type t = private {id: int; pname: Typ.Procname.t; successors: int list; mutable flag: bool}
+  type t = private
+    {id: int; pname: Typ.Procname.t; mutable successors: int list; mutable flag: bool}
 
   val make : int -> Typ.Procname.t -> int list -> t
 
+  val add_successor : t -> int -> unit
+
   val set_flag : t -> unit
 
   val unset_flag : t -> unit
@@ -21,8 +24,6 @@ end
 
 module Node : NodeSig
 
-module IdMap = Typ.Procname.Hash
-
 type t
 
 val reset : t -> unit
@@ -55,5 +56,11 @@ val trim_id_map : t -> unit
 val remove_unflagged_and_unflag_all : t -> unit
 (** remove all nodes with flag set to false, and set flag to false on all remaining nodes *)
 
-val add : t -> IdMap.key -> IdMap.key sexp_list -> unit
-(** add edges from [pname] to [successor_pnames] in the graph *)
+(* suppress unused value warning until this is used for T47276251 *)
+val add_edge : t -> pname:Typ.Procname.t -> successor_pname:Typ.Procname.t -> unit
+  [@@warning "-32"]
+(** add an edge from [pname] to [successor_pname] in the graph, creating a node for [pname] if there
+    isn't one already *)
+
+val create_node : t -> Typ.Procname.t -> Typ.Procname.t sexp_list -> unit
+(** create a new node with edges from [pname] to [successor_pnames] in the graph *)

infer/src/backend/SyntacticCallGraph.ml

@@ -25,7 +25,7 @@ let build_from_captured_procs g =
       let callees =
         Sqlite3.column stmt 1 |> Typ.Procname.SQLiteList.deserialize |> List.map ~f:hashcons_pname
       in
-      CallGraph.add g proc_name callees )
+      CallGraph.create_node g proc_name callees )
 
 
 let build_from_sources g sources =