[call-graph sched] small simplifications

Summary:
There was some over-general treatment of reachability, in anticipation of changes that didn't happen.
In particular, we only need to flag/remove single nodes, as they must be leaves to be scheduled,
therefore we never need to traverse their successors, because there aren't any.

Reviewed By: jvillard

Differential Revision: D18425905

fbshipit-source-id: b86490542

infer/src/backend/CallGraph.ml

@@ -70,7 +70,10 @@ 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)
 
-let remove (g : t) pname id = IdMap.remove g.id_map pname ; NodeMap.remove g.node_map id
+let remove (g : t) pname =
+  IdMap.remove g.id_map pname ;
+  id_of_procname g pname |> Option.iter ~f:(NodeMap.remove g.node_map)
+
 
 let get_or_set_id ({id_map} as graph) procname =
   match id_of_procname graph procname with
@@ -106,18 +109,7 @@ let add_edge ({node_map} as graph) ~pname ~successor_pname =
   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 ;
-    List.fold n.successors ~init ~f:(fun init succ_id ->
-        node_of_id g succ_id |> Option.fold ~init ~f:(fun acc s -> s :: acc) )
-  in
-  let rec remove_list frontier =
-    if not (List.is_empty frontier) then
-      remove_list (List.fold frontier ~init:[] ~f:add_live_successors_and_remove_self)
-  in
-  node_of_procname g start_pname |> Option.iter ~f:(fun start_node -> remove_list [start_node])
-
+let flag g pname = node_of_procname g pname |> Option.iter ~f:Node.set_flag
 
 let flag_reachable g start_pname =
   let process_node init (n : Node.t) =

infer/src/backend/CallGraph.mli

@@ -38,14 +38,15 @@ val n_procs : t -> int
 val mem : t -> int -> bool
 (** is an int [id] the index of a node in the graph? *)
 
+val flag : t -> Typ.Procname.t -> unit
+
 val flag_reachable : t -> Typ.Procname.t -> unit
 (** flag all nodes reachable from the node of the given procname, if it exists *)
 
 val get_unflagged_leaves : t -> Node.t list
 (** get all leaves that have their flag set to false *)
 
-val remove_reachable : t -> Typ.Procname.t -> unit
-(** remove all nodes reachable from procname *)
+val remove : t -> Typ.Procname.t -> unit
 
 val to_dotty : t -> string -> unit
 (** output call graph in dotty format with the given filename in results dir *)

infer/src/backend/SyntacticCallGraph.ml

@@ -71,7 +71,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t =
     let empty = !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled in
     if empty then (
       remaining := 0 ;
-      L.progress "Finished call graph scheduling, %d procs remaining (in cycles).@."
+      L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@."
         (CallGraph.n_procs syntactic_call_graph) ;
       if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ;
       (* save some memory *)
@@ -89,7 +89,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t =
     | n :: ns ->
         pending := ns ;
         scheduled := Typ.Procname.Set.add n.pname !scheduled ;
-        CallGraph.flag_reachable syntactic_call_graph n.pname ;
+        CallGraph.flag syntactic_call_graph n.pname ;
         Some (Procname n.pname)
   in
   let finished = function
@@ -98,7 +98,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t =
     | Procname pname ->
         decr remaining ;
         scheduled := Typ.Procname.Set.remove pname !scheduled ;
-        CallGraph.remove_reachable syntactic_call_graph pname
+        CallGraph.remove syntactic_call_graph pname
   in
   let next () =
     (* do construction here, to avoid having the call graph into forked workers *)