[callgraph] better progress info

Reviewed By: jberdine

Differential Revision: D15449387

fbshipit-source-id: 9f6733440

infer/src/backend/CallGraph.ml

@@ -46,6 +46,8 @@ module NodeMap = Caml.Hashtbl.Make (Int)
     [trim_id_map] makes the image equal to the domain of [node_map]. *)
 type t = {id_map: int IdMap.t; node_map: Node.t NodeMap.t}
 
+let clear {id_map; node_map} = IdMap.clear id_map ; NodeMap.clear node_map
+
 let create initial_capacity =
   {id_map= IdMap.create initial_capacity; node_map= NodeMap.create initial_capacity}
 
@@ -57,7 +59,7 @@ let node_of_id {node_map} id = NodeMap.find_opt node_map id
 let mem {node_map} id = NodeMap.mem node_map id
 
 (** [id_map] may contain undefined procedures, so use [node_map] for actual size *)
-let length {node_map} = NodeMap.length node_map
+let n_procs {node_map} = NodeMap.length node_map
 
 let node_of_procname g pname = id_of_procname g pname |> Option.bind ~f:(node_of_id g)
 
@@ -123,8 +125,8 @@ let pp_dot fmt {node_map} =
   F.fprintf fmt "}@."
 
 
-let to_dotty g =
-  let outc = Filename.concat Config.results_dir "callgraph.dot" |> Out_channel.create in
+let to_dotty g filename =
+  let outc = Filename.concat Config.results_dir filename |> Out_channel.create in
   let fmt = F.formatter_of_out_channel outc in
   pp_dot fmt g ; Out_channel.close outc
 
@@ -153,16 +155,15 @@ let build_from_sources g sources =
   let time0 = Mtime_clock.counter () in
   L.progress "Building call graph...@\n%!" ;
   build_from_captured_procs g ;
-  let captured_length = length g in
+  let n_captured = n_procs g in
   List.iter sources ~f:(fun sf ->
       SourceFiles.proc_names_of_source sf |> List.iter ~f:(flag_reachable g) ) ;
   remove_unflagged_and_unflag_all g ;
   trim_id_map g ;
-  if Config.debug_level_analysis > 0 then to_dotty g ;
-  L.progress "Building call graph took %a@\n" Mtime.Span.pp (Mtime_clock.count time0) ;
+  if Config.debug_level_analysis > 0 then to_dotty g "callgraph.dot" ;
   L.progress
-    "Constructed call graph from %d total procs, %d reachable defined procs, and takes %d bytes@."
-    captured_length (length g)
+    "Built call graph in %a, from %d total procs, %d reachable defined procs and takes %d bytes@."
+    Mtime.Span.pp (Mtime_clock.count time0) n_captured (n_procs g)
     (Obj.(reachable_words (repr g)) * (Sys.word_size / 8))
 
 

infer/src/backend/CallGraph.mli

@@ -23,9 +23,14 @@ module Node : NodeSig
 
 type t
 
+val clear : t -> unit
+
 val create : int -> t
 (** [create n] makes an empty graph with initial capacity [n] which grows as required *)
 
+val n_procs : t -> int
+(** number of procedures in graph *)
+
 val build_from_sources : t -> SourceFile.t list -> unit
 (** build restriction of call graph to procedures reachable from provided sources *)
 
@@ -39,3 +44,6 @@ val remove_reachable : t -> Typ.Procname.t -> unit
 (** remove all nodes reachable from procname *)
 
 val get_unflagged_leaves : t -> Node.t list
+
+val to_dotty : t -> string -> unit
+(** output call graph in dotty format with the given filename in results dir *)

infer/src/backend/TaskScheduler.ml

@@ -49,7 +49,14 @@ let bottom_up sources : target task_generator =
   let pending : CallGraph.Node.t list ref = ref [] in
   let scheduled = ref Typ.Procname.Set.empty in
   let is_empty () =
-    !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled
+    let empty = !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled in
+    if empty then (
+      L.progress "Finished call graph scheduling, %d procs remaining (in cycles).@."
+        (CallGraph.n_procs g) ;
+      if Config.debug_level_analysis > 0 then CallGraph.to_dotty g "cycles.dot" ;
+      (* save some memory *)
+      CallGraph.clear g ) ;
+    empty
   in
   let rec next_aux () =
     match !pending with