diff --git a/infer/src/backend/CallGraph.ml b/infer/src/backend/CallGraph.ml index b3a7dba97..c41efe058 100644 --- a/infer/src/backend/CallGraph.ml +++ b/infer/src/backend/CallGraph.ml @@ -147,11 +147,10 @@ let remove_unflagged_and_unflag_all {id_map; node_map} = node_map -let get_unflagged_leaves g = - NodeMap.fold - (fun _id (n : Node.t) acc -> - if n.flag || List.exists n.successors ~f:(mem g) then acc else n :: acc ) - g.node_map [] +let iter_unflagged_leaves ~f g = + NodeMap.iter + (fun _id (n : Node.t) -> if not (n.flag || List.exists n.successors ~f:(mem g)) then f n) + g.node_map let fold_flagged graph ~f = diff --git a/infer/src/backend/CallGraph.mli b/infer/src/backend/CallGraph.mli index 836f1dd51..7e24e6803 100644 --- a/infer/src/backend/CallGraph.mli +++ b/infer/src/backend/CallGraph.mli @@ -42,8 +42,8 @@ val flag : t -> Procname.t -> unit val flag_reachable : t -> 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 iter_unflagged_leaves : f:(Node.t -> unit) -> t -> unit +(** iterate over all leaves that have their flag set to false *) val remove : t -> Procname.t -> unit diff --git a/infer/src/backend/SyntacticCallGraph.ml b/infer/src/backend/SyntacticCallGraph.ml index 2ff0cbad0..8de762317 100644 --- a/infer/src/backend/SyntacticCallGraph.ml +++ b/infer/src/backend/SyntacticCallGraph.ml @@ -51,32 +51,34 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t = let syntactic_call_graph = build_from_sources sources in let remaining = ref (CallGraph.n_procs syntactic_call_graph) in let remaining_tasks () = !remaining in - let pending = - (* prime the pending queue so that [empty] doesn't immediately return true *) - ref (CallGraph.get_unflagged_leaves syntactic_call_graph) + let pending : CallGraph.Node.t Queue.t = Queue.create () in + let fill_queue () = + CallGraph.iter_unflagged_leaves ~f:(Queue.enqueue pending) syntactic_call_graph in + (* prime the pending queue so that [empty] doesn't immediately return true *) + fill_queue () ; let scheduled = ref Procname.Set.empty in let is_empty () = - let empty = List.is_empty !pending && Procname.Set.is_empty !scheduled in + let empty = Queue.is_empty pending && Procname.Set.is_empty !scheduled in if empty then ( remaining := 0 ; 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 *) - CallGraph.reset syntactic_call_graph ) ; + CallGraph.reset syntactic_call_graph ; + (* there is no equivalent to [Hashtbl.reset] so set capacity to min, freeing the old array *) + Queue.set_capacity pending 1 ) ; empty in let rec next () = - match !pending with - | [] -> - pending := CallGraph.get_unflagged_leaves syntactic_call_graph ; - if List.is_empty !pending then None else next () - | n :: ns when n.flag || not (CallGraph.mem syntactic_call_graph n.id) -> - pending := ns ; + match Queue.dequeue pending with + | None -> + fill_queue () ; + if Queue.is_empty pending then None else next () + | Some n when n.flag || not (CallGraph.mem syntactic_call_graph n.id) -> next () - | n :: ns -> - pending := ns ; + | Some n -> scheduled := Procname.Set.add n.pname !scheduled ; CallGraph.flag syntactic_call_graph n.pname ; Some (Procname n.pname)