(*
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)
open! IStd
module L = Logging
module IdMap = Procname.Hash

let build_from_captured_procs g =
  let hashcons_pname =
    let pname_tbl : Procname.t IdMap.t = IdMap.create 1001 in
    fun pname ->
      match IdMap.find_opt pname_tbl pname with
      | Some pname' ->
          pname'
      | None ->
          IdMap.add pname_tbl pname pname ; pname
  in
  let db = ResultsDatabase.get_database () in
  let stmt = Sqlite3.prepare db "SELECT proc_name, callees FROM procedures" in
  SqliteUtils.result_fold_rows db ~log:"creating call graph" stmt ~init:() ~f:(fun () stmt ->
      let proc_name = Sqlite3.column stmt 0 |> Procname.SQLite.deserialize |> hashcons_pname in
      let callees =
        Sqlite3.column stmt 1 |> Procname.SQLiteList.deserialize |> List.map ~f:hashcons_pname
      in
      CallGraph.create_node g proc_name callees )


let build_from_sources sources =
  let g = CallGraph.create CallGraph.default_initial_capacity in
  let time0 = Mtime_clock.counter () in
  L.progress "Building call graph...@\n%!" ;
  build_from_captured_procs g ;
  let n_captured = CallGraph.n_procs g in
  List.iter sources ~f:(fun sf ->
      SourceFiles.proc_names_of_source sf |> List.iter ~f:(CallGraph.flag_reachable g) ) ;
  CallGraph.remove_unflagged_and_unflag_all g ;
  CallGraph.trim_id_map g ;
  if Config.debug_level_analysis > 0 then CallGraph.to_dotty g "syntactic_callgraph.dot" ;
  L.progress
    "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 (CallGraph.n_procs g)
    (Obj.(reachable_words (repr g)) * (Sys.word_size / 8)) ;
  g


let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t =
  let open SchedulerTypes in
  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)
  in
  let scheduled = ref Procname.Set.empty in
  let is_empty () =
    let empty = List.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 ) ;
    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 ;
        next ()
    | n :: ns ->
        pending := ns ;
        scheduled := Procname.Set.add n.pname !scheduled ;
        CallGraph.flag syntactic_call_graph n.pname ;
        Some (Procname n.pname)
  in
  let finished ~completed:_ = function
    | Procname pname ->
        decr remaining ;
        scheduled := Procname.Set.remove pname !scheduled ;
        CallGraph.remove syntactic_call_graph pname
    | File _ ->
        L.die InternalError "Only Procnames are scheduled but File target was received"
  in
  {remaining_tasks; is_empty; finished; next}


let make sources = ProcessPool.TaskGenerator.chain (bottom_up sources) (FileScheduler.make sources)