open Fugue
open Filepath
open Types
open Helper
open Printf
open Analyze
open Target
open Prepare
open Gconf
open Buildprogs

exception CCompilationFailed of string
exception CompilationFailed of string
exception InternalInconsistency of string * string

(* Polling constants for waiting on filesystem *)
let poll_interval_sec = 0.02          (* 20ms between file existence checks *)
let mtime_poll_interval_sec = 0.01    (* 10ms between mtime freshness checks *)
let mtime_poll_timeout_sec = 5.0      (* safety timeout for mtime polling *)
let initial_task_context_size = 64

(* Timestamp set at the start of each compile phase.  C object files whose
   mtime is >= this value were compiled during the current build run and may
   need mtime-freshness polling.  Files older than this are from a previous
   run and need no polling. *)
let build_start_time = ref 0.0

(* check that destination is valid (mtime wise) against a list of srcs and
 * if not valid gives the filepath that has changed.
 *)
let check_destination_valid_with srcs (_, dest) =
  if Filesystem.exists dest then
    let dest_time = Filesystem.get_modification_time dest in
    try
      Some
        (List.find
           (fun (_, path) ->
             let mtime = Filesystem.get_modification_time path in
             dest_time < mtime)
           srcs)
    with Not_found -> None
  else
    Some (Filetype.FileO, current_dir)

(* same as before but the list of sources is automatically determined
 * from the file DAG
 *)
let check_destination_valid cstate (filety, dest) =
  let children =
    try Dag.get_children cstate.compilation_filesdag (Filetype.make_id (filety, dest))
    with Dag.DagNodeNotFound ->
      raise
        (InternalInconsistency
           (Filetype.to_string filety, "missing destination: " ^ fp_to_string dest))
  in
  check_destination_valid_with (List.map Filetype.get_id children) (filety, dest)

(* get a nice reason of why a destination is not deemed valid against
 * the source filepath that triggered the unvalid check.
 *
 * if source filepath is empty, it means that destination doesn't exists *)
let reason_from_paths (_, dest) (srcTy, changedSrc) =
  let trim_pd_exts z =
    let n = fn_to_string z in
    if String_utils.endswith ".d" n then
      fn (Filename.chop_suffix n ".d")
    else if String_utils.endswith ".p" n then
      fn (Filename.chop_suffix n ".p")
    else
      z
  in
  if changedSrc = current_dir then
    ""
  else
    let bdest = path_basename dest in
    let bsrc = path_basename changedSrc in
    match (Filetype.of_filename bdest, srcTy) with
    | (Filetype.FileCMX | Filetype.FileCMO), (Filetype.FileCMX | Filetype.FileCMO) ->
        let bml = Filetype.replace_extension bdest Filetype.FileML in
        let bmli = Filetype.replace_extension bdest Filetype.FileMLI in
        if bml = bsrc then
          "Source changed"
        else if bmli = bsrc then
          "Interface changed"
        else
          "Dependency "
          ^ Modname.to_string (Modname.of_filename (trim_pd_exts bsrc))
          ^ " changed " ^ fp_to_string changedSrc
    | (Filetype.FileCMX | Filetype.FileCMO), (Filetype.FileCMXA | Filetype.FileCMA) ->
        "Library changed " ^ fp_to_string changedSrc
    | (Filetype.FileCMX | Filetype.FileCMO), _ ->
        "Dependencies changed " ^ fp_to_string changedSrc
    | Filetype.FileO, _ ->
        let bc = Filetype.replace_extension bdest Filetype.FileC in
        let bh = Filetype.replace_extension bdest Filetype.FileH in
        if bc = bsrc then
          "C file " ^ fn_to_string bsrc ^ " changed"
        else if bh = bsrc then
          "H file " ^ fn_to_string bsrc ^ " changed"
        else
          "file changed " ^ fp_to_string changedSrc
    | _, _ -> fp_to_string changedSrc ^ " changed"

let get_all_modes target =
  let compile_opts = Target.get_compilation_opts target in
  let compiled_types = Target.get_ocaml_compiled_types target in
  let all_modes =
    List.concat
      (List.map (fun ty -> List.map (fun cmode -> (ty, cmode)) compile_opts) compiled_types)
  in
  List.filter
    (fun (t, o) ->
      match (t, o) with
      | ByteCode, WithProf -> false
      | _ -> true)
    all_modes

let annot_mode () =
  if Gconf.get_target_option_typed Annot && gconf.bin_annot then
    AnnotationBoth
  else if Gconf.get_target_option_typed Annot then
    AnnotationText
  else if gconf.bin_annot then
    AnnotationBin
  else
    AnnotationNone

let get_nb_step dag =
  let nb_step = Dag.length dag in
  let nb_step_len = String.length (string_of_int nb_step) in
  (nb_step, nb_step_len)

let buildmode_to_filety bmode = if bmode = Native then Filetype.FileCMX else Filetype.FileCMO

let buildmode_to_library_filety bmode =
  if bmode = Native then Filetype.FileCMXA else Filetype.FileCMA

let internal_libs_paths self_deps =
  let tbl = Hashtbl.create 6 in
  List.iter
    (fun (compile_opt, compile_type) ->
      let paths =
        List.map
          (fun dep ->
            let dirname = Dist.get_build_exn (Dist.Target (Name.Lib dep)) in
            let filety = buildmode_to_library_filety compile_type in
            let libpath = dirname </> Libname.to_cmca compile_type compile_opt dep in
            (filety, libpath))
          self_deps
      in
      Hashtbl.replace tbl (compile_opt, compile_type) paths)
    (List.concat (List.map (fun opt ->
      List.map (fun ty -> (opt, ty)) [Native; ByteCode])
      [Normal; WithProf; WithDebug]));
  tbl

(* Helper: get include paths for ctypes from dependencies *)

(* Generate ctypes.cstubs type discovery - produces types_generated.ml *)
let generate_cstubs_types = Build_cstubs.generate_cstubs_types

(* Generate ctypes.cstubs function stubs - produces C.ml and stubs.c *)
let generate_cstubs_functions = Build_cstubs.generate_cstubs_functions

(* Compile generated ctypes.cstubs C code *)
let compile_cstubs_c = Build_cstubs.compile_cstubs_c

(* Run explicit generate block *)
let run_generate_block task_index task (gen_block : Target.target_generate) _bstate task_context dag =
  let _cstate, _target = Hashtbl.find task_context task in
  let autogenDir = Dist.get_build_exn Dist.Autogen in

  (* Match a filename against a glob pattern segment (e.g., "*.scm", "*") *)
  let matches_glob_pattern pattern name =
    let name_str = fn_to_string name in
    if pattern = "*" then true
    else if String.length pattern > 1 && pattern.[0] = '*' then
      let suffix = String.sub pattern 1 (String.length pattern - 1) in
      String_utils.endswith suffix name_str
    else
      name_str = pattern
  in

  (* Collect all files recursively under a directory *)
  let rec collect_all_files base =
    try
      let accum = ref [] in
      Filesystem.iterate (fun entry ->
        let full = base </> entry in
        if Filesystem.is_dir full then
          accum := !accum @ collect_all_files full
        else
          accum := full :: !accum
      ) base;
      !accum
    with Sys_error _ -> []
  in

  (* Expand glob patterns in generate_from *)
  let expand_pattern pattern =
    let pattern_str = fp_to_string pattern in
    if not (String.contains pattern_str '*') then
      [pattern]
    else
      let segments = String_utils.split Filename.dir_sep.[0] pattern_str in
      (* Split into leading literal path and glob segments *)
      let rec split_at_glob acc = function
        | [] -> (List.rev acc, [])
        | seg :: rest when String.contains seg '*' -> (List.rev acc, seg :: rest)
        | seg :: rest -> split_at_glob (seg :: acc) rest
      in
      let (literal_parts, glob_parts) = split_at_glob [] segments in
      let base = match literal_parts with
        | [] -> current_dir
        | parts -> fp (String.concat Filename.dir_sep parts)
      in
      let rec glob_match base_path = function
        | [] -> [base_path]
        | "**" :: [] ->
            (* ** at end: all files recursively *)
            collect_all_files base_path
        | "**" :: rest ->
            (* ** matches zero or more directory levels *)
            let zero_match = glob_match base_path rest in
            let sub_matches =
              try
                let accum = ref [] in
                Filesystem.iterate (fun entry ->
                  let full = base_path </> entry in
                  if Filesystem.is_dir full then
                    accum := !accum @ glob_match full ("**" :: rest)
                ) base_path;
                !accum
              with Sys_error _ -> []
            in
            zero_match @ sub_matches
        | [file_pattern] ->
            (* Terminal segment: match files *)
            (try
              Filesystem.list_dir_pred (fun entry ->
                (not (Filesystem.is_dir (base_path </> entry))) &&
                matches_glob_pattern file_pattern entry
              ) base_path
              |> List.map (fun entry -> base_path </> entry)
            with Sys_error _ -> [])
        | dir_pattern :: rest ->
            (* Non-terminal segment: match directories and recurse *)
            (try
              let subdirs = Filesystem.list_dir_pred (fun entry ->
                Filesystem.is_dir (base_path </> entry) &&
                matches_glob_pattern dir_pattern entry
              ) base_path in
              List.concat (List.map (fun d ->
                glob_match (base_path </> d) rest
              ) subdirs)
            with Sys_error _ -> [])
      in
      let results = glob_match base glob_parts in
      List.sort compare results
  in

  let sources = List.concat (List.map expand_pattern gen_block.generate_from) in

  (* Check if any source is newer than output *)
  let output_module = gen_block.generate_module in
  let output_file = autogenDir </> fn (Compat.string_lowercase (Hier.to_string output_module) ^ ".ml") in

  let needs_rebuild =
    if not (Filesystem.exists output_file) then true
    else
      let output_mtime = Filesystem.get_modification_time output_file in
      List.exists (fun src ->
        Filesystem.exists src &&
        Filesystem.get_modification_time src > output_mtime
      ) sources
  in

  if needs_rebuild then begin
    let nb_step, nb_step_len = get_nb_step dag in
    log Report "[%*d of %d] Generating %-30s\n%!" nb_step_len task_index nb_step
      (Hier.to_string output_module);
    let dest = autogenDir </> fn (Compat.string_lowercase (Hier.to_string output_module)) in
    Generators.run_custom_multi
      ~generator_name:gen_block.generate_using
      ~dest
      ~sources
      ~extra_args:gen_block.generate_args
  end;

  Scheduler.FinishTask task

(* compile C files *)
let compile_c task_index task c_file bstate task_context dag =
  let cstate, target = Hashtbl.find task_context task in
  let cbits = target.target_cbits in
  let c_dir_spec =
    {
      include_dirs = cstate.compilation_c_include_paths;
      dst_dir = cstate.compilation_builddir_c;
      src_dir = cbits.target_cdir;
    }
  in
  let dest = (Filetype.FileO, c_dir_spec.dst_dir </> o_from_cfile c_file) in
  match check_destination_valid cstate dest with
  | None -> Scheduler.FinishTask task
  | Some src_changed ->
      let reason = reason_from_paths dest src_changed in
      let nb_step, nb_step_len = get_nb_step dag in
      log Report "[%*d of %d] Compiling C %-30s%s\n%!" nb_step_len task_index nb_step
        (fn_to_string c_file)
        (if reason <> "" then "    ( " ^ reason ^ " )" else "");
      let cflags = cbits.target_cflags in
      Scheduler.AddProcess (task, run_c_compile bstate.bstate_config c_dir_spec cflags c_file)

(* compile a set of modules in directory into a pack *)
let compile_directory task_index task (h : Hier.t) task_context dag =
  let cstate, target = Hashtbl.find task_context task in
  let pack_opt = Hier.parent h in
  (* get all the modules defined at level h+1 *)
  let modules_task = Taskdep.linearize cstate.compilation_dag Taskdep.FromParent [ task ] in
  let filter_modules t : Hier.t option =
    match t with
    | CompileC _ | LinkTarget _ | CheckTarget _ -> None
    | GenerateCstubsTypes _ | GenerateCstubsFunctions _ | CompileCstubsC _ | RunGenerateBlock _ -> None
    | CompileDirectory m | CompileModule m -> if Hier.lvl m = Hier.lvl h + 1 then Some m else None
    | CompileInterface m ->
        if Hier.lvl m = Hier.lvl h + 1 then begin
          let fe = Hier.get_file_entry_maybe m in
          match fe with
          | None -> None
          | Some e -> (
              match e with
              | Hier.FileEntry (_, f) ->
                  if Filetype.of_filepath f = Filetype.FileMLI then
                    Some m
                  else
                    None
              | _ -> None)
        end
        else
          None
  in
  let modules = List.rev $ list_filter_map filter_modules modules_task in
  let all_modes = get_all_modes target in
  let annot_mode = annot_mode () in
  (* directory never have interface (?) so we serialize the native/bytecode creation.
   * the mtime checking is sub-optimal. low hanging fruits warning *)
  let tasks_ops : (string * Scheduler.call) option list list =
    let byte_list, native_list = List.partition (fun (t, _) -> t = ByteCode) all_modes in
    List.map
      (fun pair_list ->
        List.map
          (fun (build_mode, comp_opt) ->
            let path = cstate.compilation_builddir_ml comp_opt in
            let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in
            let mdeps =
              List.map
                (fun m -> (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI m))
                modules
            in
            let dir = cstate.compilation_builddir_ml comp_opt in
            let fcompile =
             fun () -> run_ocaml_pack dir dir annot_mode build_mode pack_opt h modules
            in
            match check_destination_valid_with mdeps dest with
            | None -> None
            | Some src_changed -> Some (reason_from_paths dest src_changed, fcompile))
          pair_list)
      [ byte_list; native_list ]
  in
  let reason, ops =
    (*[ [(r,f)] ]*)
    let l : (string * Scheduler.call) list list = List.map maybes_to_list tasks_ops in
    match List.filter (fun x -> x <> []) l with
    | [] -> ("", [])
    | ((r, x) :: xs) :: ys -> (r, (x :: List.map snd xs) :: List.map (List.map snd) ys)
  in
  if ops <> [] then (
    let nb_step, nb_step_len = get_nb_step dag in
    log Report "[%*d of %d] Packing %-30s%s\n%!" nb_step_len task_index nb_step
      (Hier.to_string h) reason;
    Scheduler.AddTask (task, ops))
  else
    Scheduler.FinishTask task

(** Helper: Check if recompilation is needed and prepare compilation functions

    Examines source files and dependencies to determine if recompilation is required. Returns a pair
    of (compilation_reason option, list of compilation functions). *)
let check_compilation_needed is_intf dep_descs dir_spec use_thread annot_mode pack_opt use_pp oflags
    h cstate =
  let rec check invalid descs =
    match descs with
    | [] -> (None, [])
    | (dest, build_mode, comp_opt, srcs) :: xs -> (
        let r_dir_spec =
          {
            dir_spec with
            dst_dir = cstate.compilation_builddir_ml comp_opt <//> Hier.to_dirpath h;
            include_dirs = cstate.compilation_include_paths comp_opt h;
          }
        in
        let fcompile =
          ( build_mode,
            fun () ->
              run_ocaml_compile r_dir_spec use_thread annot_mode build_mode comp_opt pack_opt use_pp
                oflags h )
        in
        if invalid then
          let _, ys = check invalid xs in
          (Some "", fcompile :: ys)
        else
          match
            check_destination_valid_with srcs dest
          with
          | None -> check false xs
          | Some src_changed ->
              let reason = reason_from_paths dest src_changed in
              let _, ys = check true xs in
              (Some reason, fcompile :: ys))
  in
  check false dep_descs

(** Helper: Organize compilation functions based on build modes

    Groups compilation functions appropriately:
    - Interface compilations run in parallel
    - Modules with interfaces run in parallel
    - Modules without interfaces partition native/bytecode builds *)
let organize_compilation_functions is_intf check_fun_list hdesc =
  if is_intf || Module.file_has_interface hdesc then
    [ List.map snd check_fun_list ]
  else
    let l1, l2 = List.partition (fun (x, _) -> x = Compiled Native) check_fun_list in
    List.filter (fun x -> x <> []) [ List.map snd l1; List.map snd l2 ]

let dep_descs is_intf hdesc bstate cstate target h =
  let self_deps = Analyze.get_internal_library_deps bstate.bstate_config target in
  let internal_libs_paths_all_modes = internal_libs_paths self_deps in
  let module_deps = hdesc.Module.File.dep_cwd_modules in
  let compile_opts = Target.get_compilation_opts target in
  let all_modes = get_all_modes target in
  if is_intf then
    let intf_desc =
      match hdesc.Module.File.intf_desc with
      | None -> failwith "assertion error, task interface and no module_intf"
      | Some intf -> intf
    in
    List.map
      (fun comp_opt ->
        let path = cstate.compilation_builddir_ml comp_opt in
        let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in
        let src = [ (Filetype.FileMLI, intf_desc.Module.Intf.path) ] in
        let m_deps =
          List.map
            (fun module_dep ->
              (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep))
            module_deps
        in
        let internal_deps = Hashtbl.find internal_libs_paths_all_modes (comp_opt, ByteCode) in
        (dest, Interface, comp_opt, src @ internal_deps @ m_deps))
      compile_opts
  else
    List.map
      (fun (compiled_ty, comp_opt) ->
        let file_compile_ty = buildmode_to_filety compiled_ty in
        let ext = if compiled_ty = ByteCode then Filetype.FileCMO else Filetype.FileCMX in
        let path = cstate.compilation_builddir_ml comp_opt in
        let dest = (file_compile_ty, Hier.get_dest_file path ext h) in
        let src =
          (match hdesc.Module.File.intf_desc with
            | None -> []
            | Some intf -> [ (Filetype.FileMLI, intf.Module.Intf.path) ])
          @ [ (Filetype.FileML, hdesc.Module.File.path) ]
        in
        let own_cmi_dep =
          match hdesc.Module.File.intf_desc with
          | None -> []
          | Some _ ->
              (* Add dependency on the module's own .cmi file *)
              [ (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) ]
        in
        let m_deps =
          own_cmi_dep
          @ List.concat
              (List.map
                 (fun module_dep ->
                   (* In bytecode mode, .cmo files only depend on .cmi files of dependencies.
               In native mode, .cmx files depend on both .cmx (for inlining) and .cmi *)
                   let compiled_file_dep =
                     if compiled_ty = Native then
                       [ (file_compile_ty, Hier.get_dest_file path ext module_dep) ]
                     else
                       []
                   in
                   compiled_file_dep
                   @ [ (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep) ])
                 module_deps)
        in
        let internal_deps = Hashtbl.find internal_libs_paths_all_modes (comp_opt, compiled_ty) in
        (dest, Compiled compiled_ty, comp_opt, src @ internal_deps @ m_deps))
      all_modes

(* add a OCaml module or interface compilation process *)
let compile_module task_index task is_intf h bstate task_context dag =
  let all = Hashtbl.find_all task_context task in
  let process_one_target cstate target =
    let pack_opt = Hier.parent h in
    let hdesc =
      let desc = Hashtbl.find cstate.compilation_modules h in
      match desc with
      | Module.DescFile z -> z
      | Module.DescDir _ ->
          failwith
            (sprintf "internal error compile module on directory (%s). steps dag internal error"
               (Hier.to_string h))
    in
    let src_path = path_dirname hdesc.Module.File.path in
    let use_thread = hdesc.Module.File.use_threads in
    let dir_spec = { src_dir = src_path; dst_dir = current_dir; include_dirs = [ current_dir ] } in
    let dep_descs = dep_descs is_intf hdesc bstate cstate target h in
    let annot_mode = annot_mode () in
    let check_result =
      check_compilation_needed is_intf dep_descs dir_spec use_thread annot_mode pack_opt
        hdesc.Module.File.use_pp hdesc.Module.File.oflags h cstate
    in
    (check_result, hdesc)
  in
  let all = List.map (fun (c, t) -> process_one_target c t) all in
  match all with
  | [] -> Scheduler.FinishTask task
  | ((compilation_reason, _), _) :: _ ->
  match compilation_reason with
  | None -> Scheduler.FinishTask task
  | Some reason ->
      (* if the module has an interface, we create one list, so everything can be run in parallel,
       * otherwise we partition the build_mode functions in build_modes group. *)
      let all_fun_lists =
        List.fold_left
          (fun l ((_, check), hdesc) ->
            let funlist = organize_compilation_functions is_intf check hdesc in
            l @ funlist)
          [] all
      in

      let verb = if is_intf then "Intfing" else "Compiling" in
      let nb_step, nb_step_len = get_nb_step dag in
      log Report "[%*d of %d] %s %-30s%s\n%!" nb_step_len task_index nb_step verb
        (Hier.to_string h)
        (if reason <> "" then "    ( " ^ reason ^ " )" else "");
      Scheduler.AddTask (task, all_fun_lists)

let wait_for_files cdep_files =
  let max_wait = 30.0 in
  let start = Unix.gettimeofday () in
  let rec loop remaining =
    match remaining with
    | [] -> true
    | _ ->
      if Unix.gettimeofday () -. start > max_wait then begin
        log Report "warning: timed out waiting for files: %s"
          (String.concat ", " (List.map fp_to_string remaining));
        false
      end else
        let still_missing =
          List.filter
            (fun f ->
              let test = Filesystem.exists f in
              if not test then
                log Debug "warning: (temporarily?) missing file %s" (fp_to_string f);
              not test)
            remaining
        in
        if still_missing = [] then true
        else begin
          ignore (Unix.select [] [] [] poll_interval_sec);
          loop still_missing
        end
  in
  loop cdep_files

let link_c cstate clib_name =
  let lib_name = cstate.compilation_builddir_c </> fn clib_name in
  let cdep_files =
    List.map (fun x -> cstate.compilation_builddir_c </> o_from_cfile x) cstate.compilation_csources
  in
  (* Not sure why it is necessary ... gcc seems to return before the files are ready. *)
  ignore (wait_for_files cdep_files);
  if gconf.ocamlmklib then
    [ [ (fun () -> run_c_linking LinkingShared cdep_files lib_name) ] ]
  else
    let so_file = cstate.compilation_builddir_c </> fn (Utils.shared_lib_name clib_name) in
    let a_file = cstate.compilation_builddir_c </> fn (Utils.static_lib_name clib_name) in
    [
      [ (fun () -> run_c_linking LinkingShared cdep_files so_file) ];
      [ (fun () -> run_ar a_file cdep_files) ];
      [ (fun () -> run_ranlib a_file) ];
    ]

let satisfy_preds dep preds =
  let satisfy_all current_pkg =
    let res =
      List.fold_left
        (fun acc (req_preds, req_libs) ->
          List.fold_left
            (fun _in_acc lib -> if lib = dep then Meta.Pkg.satisfy req_preds preds else true)
            acc req_libs)
        true current_pkg.Meta.Pkg.requires
    in
    res
  in
  let rec dep_is_satisfied current_pkg =
    satisfy_all current_pkg && List.for_all satisfy_all current_pkg.Meta.Pkg.subs
  in
  let _, root_pkg = Metacache.get dep.Libname.main_name in
  dep_is_satisfied root_pkg

(** Helper: Resolve build dependencies to actual library file paths *)
let resolve_build_dependencies bstate pkgDeps compiledType compileOpt useThreadLib is_lib_target =
  let systhread = Analyze.get_ocaml_config_key_global "systhread_supported" in
  if is_lib_target then
    []
  else
    List.flatten
      (List.map
         (fun dep ->
           match Hashtbl.find bstate.bstate_config.project_dep_data dep with
           | Internal -> [ in_current_dir (Libname.to_cmca compiledType compileOpt dep) ]
           | System ->
               let path, rootPkg = Metacache.get_from_cache dep in
               let libDir =
                 Meta.get_include_dir_with_subpath
                   (fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config))
                   (path, rootPkg) dep.Libname.subnames
               in
               let pred =
                 match compiledType with
                 | Native -> Meta.Predicate.Native
                 | ByteCode -> Meta.Predicate.Byte
               in
               let preds =
                 match useThreadLib with
                 | PosixThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_posix ]
                 | VMThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_vm ]
                 | DefaultThread ->
                     (if systhread = "true" then Meta.Predicate.Mt_posix else Meta.Predicate.Mt_vm)
                     :: [ pred; Meta.Predicate.Mt ]
                 | NoThreads -> [ pred ]
               in
               let preds =
                 match compileOpt with
                 | WithProf -> Meta.Predicate.Gprof :: preds
                 | _ -> preds
               in
               if satisfy_preds dep preds then
                 let archives = Meta.Pkg.get_archive_with_filter (path, rootPkg) dep preds in
                 List.fold_left
                   (fun acc (_, a) ->
                     let files = String_utils.split ' ' a in
                     acc @ List.map (fun f -> libDir </> fn f) files)
                   [] archives
               else
                 [])
         pkgDeps)

(** Helper: Calculate destination path for linked output *)
let get_link_destination cstate target compiledType compileOpt plugin =
  match target.target_name with
  | Name.Lib libname ->
      if plugin then
        cstate.compilation_builddir_ml Normal </> Libname.to_cmxs compileOpt libname
      else
        cstate.compilation_builddir_ml Normal </> Libname.to_cmca compiledType compileOpt libname
  | _ ->
      let outputName =
        Utils.to_exe_name compileOpt compiledType (Target.get_target_dest_name target)
      in
      cstate.compilation_builddir_ml Normal </> outputName

(** Helper: Wait for C object files to be ready with fresh modification times.

    Filesystem buffering can cause stat() to return stale mtimes even after the
    C compiler has finished.  We only need to poll when a C file was actually
    compiled during the current build run (mtime >= build_start_time).  On a
    cached build all .o files are older than build_start_time, so the poll is
    skipped entirely — this is what was causing the ~5 s delay per link mode. *)
let wait_for_c_objects c_obj_files destTime =
  if c_obj_files <> [] then (
    ignore (wait_for_files c_obj_files);
    (* Only poll when at least one .o file was written during this build run. *)
    let any_recently_compiled =
      List.exists
        (fun obj_file ->
          try Filesystem.get_modification_time obj_file >= !build_start_time
          with Unix.Unix_error _ -> false)
        c_obj_files
    in
    if any_recently_compiled then (
      let max_wait_time = Unix.gettimeofday () +. mtime_poll_timeout_sec in
      let rec poll_fresh () =
        if Unix.gettimeofday () > max_wait_time then
          log Debug "Warning: timeout waiting for C object mtimes to update\n"
        else
          let all_fresh =
            List.for_all
              (fun obj_file ->
                try Filesystem.get_modification_time obj_file > destTime
                with Unix.Unix_error _ -> false)
              c_obj_files
          in
          if not all_fresh then (
            ignore (Unix.select [] [] [] mtime_poll_interval_sec);
            poll_fresh ())
      in
      poll_fresh ()))

(** Helper: Check if relinking is needed by comparing modification times *)
let check_needs_relink cstate compiled c_obj_files dest compiledType compileOpt =
  let destTime = Filesystem.get_modification_time dest in
  let ext = if compiledType = ByteCode then Filetype.FileCMO else Filetype.FileCMX in
  let path = cstate.compilation_builddir_ml compileOpt in

  (* Wait for C objects to have fresh mtimes (skipped automatically on cached
     builds — see wait_for_c_objects). *)
  wait_for_c_objects c_obj_files destTime;

  (* Check OCaml module files *)
  try
    Some
      (List.find
         (fun p -> destTime < Filesystem.get_modification_time p)
         (List.map (fun m -> Hier.get_dest_file path ext m) compiled))
  with Not_found -> (
    (* Also check C object files *)
    try Some (List.find (fun p -> destTime < Filesystem.get_modification_time p) c_obj_files)
    with Not_found -> None)

(** Main linking function - orchestrates dependency resolution, freshness checking, and linking *)
let link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType
    compileOpt plugin =
  let buildDeps =
    resolve_build_dependencies bstate pkgDeps compiledType compileOpt useThreadLib (is_lib target)
  in
  let dest = get_link_destination cstate target compiledType compileOpt plugin in

  let linking_paths_of compileOpt =
    match compileOpt with
    | Normal -> cstate.compilation_linking_paths
    | WithDebug -> cstate.compilation_linking_paths_d
    | WithProf -> cstate.compilation_linking_paths_p
  in

  let c_obj_files =
    List.map
      (fun csrc -> cstate.compilation_builddir_c </> o_from_cfile csrc)
      cstate.compilation_csources
  in

  let depsTime = check_needs_relink cstate compiled c_obj_files dest compiledType compileOpt in

  if depsTime <> None then (
    let nb_step, nb_step_len = get_nb_step dag in
    let systhread = Analyze.get_ocaml_config_key_global "systhread_supported" in
    let link_type =
      if plugin then
        LinkingPlugin
      else if is_lib target then
        LinkingLibrary
      else
        LinkingExecutable
    in
    log Report "[%*d of %d] Linking %s %s\n%!" nb_step_len task_index nb_step
      (if is_lib target then "library" else "executable")
      (fp_to_string dest);
    [
      (fun () ->
        run_ocaml_linking (linking_paths_of compileOpt) compiledType link_type compileOpt
          useThreadLib systhread target.target_obits.target_oflags cclibs buildDeps compiled dest);
    ])
  else
    []

let link task_index task bstate task_context dag =
  let cstate, target = Hashtbl.find task_context task in
  let cbits = target.target_cbits in
  let compiled = get_compilation_order cstate in
  log Debug "  compilation order: %s\n" (Utils.showList "," Hier.to_string compiled);
  let selfDeps = Analyze.get_internal_library_deps bstate.bstate_config target in
  log Debug "  self deps: %s\n" (Utils.showList "," Libname.to_string selfDeps);
  let selfLibDirs =
    List.map (fun dep -> Dist.get_build_exn (Dist.Target (Name.Lib dep))) selfDeps
  in
  (* Helper: find library by name in project *)
  let find_lib_by_name libname =
    try
      Some (List.find (fun lib -> lib.Project.Library.name = libname)
              bstate.bstate_config.Analyze.project_file.Project.libs)
    with Not_found -> None
  in
  (* Collect cstubs info and internal C library info from dependencies *)
  let deps_cstubs_info =
    list_filter_map (fun dep_name ->
      match find_lib_by_name dep_name with
      | Some lib ->
          (match lib.Project.Library.target.Target.target_cstubs with
           | Some cstubs ->
               Some (dep_name, cstubs.Target.cstubs_external_library_name)
           | None -> None)
      | None -> None
    ) selfDeps
  in
  (* Collect internal C library names from dependencies that have csources *)
  let deps_internal_cclibs =
    list_filter_map (fun dep_name ->
      match find_lib_by_name dep_name with
      | Some lib ->
          if lib.Project.Library.target.Target.target_cbits.Target.target_csources <> [] then
            Some (Target.Name.get_clibname (Name.Lib dep_name))
          else
            None
      | None -> None
    ) selfDeps
  in
  (* cstubs objects are now included in the main stubs library, not separate *)
  (* Get cstubs libs from dependencies - they use the standard stubs_<libname> naming *)
  let deps_cstubs_cclibs =
    List.map (fun (dep_name, _) -> Target.Name.get_clibname (Name.Lib dep_name)) deps_cstubs_info
  in
  (* Internal C library: created if we have c-sources OR cstubs *)
  let has_c_lib = cstate.compilation_csources <> [] || target.target_cstubs <> None in
  let internal_cclibs =
    if has_c_lib then
      [ Target.get_target_clibname target ]
    else
      []
  in
  let cclibs =
    List.concat
      (List.map
         (fun (cpkg, _) ->
           List.map (fun x -> "-l" ^ x) (Analyze.get_c_pkg cpkg bstate.bstate_config).cpkg_conf_libs)
         cbits.target_cpkgs)
    @ List.map (fun x -> "-L" ^ fp_to_string x) selfLibDirs
    @ List.map (fun x -> "-l" ^ x) (cbits.target_clibs @ deps_cstubs_cclibs @ internal_cclibs @ deps_internal_cclibs)
  in
  let pkgDeps = Analyze.get_pkg_deps target bstate.bstate_config in
  log Verbose "package deps: [%s]\n" (Utils.showList "," Libname.to_string pkgDeps);
  let useThreadLib =
    if List.mem (Libname.of_string "threads") pkgDeps then
      DefaultThread
    else if List.mem (Libname.of_string "threads.posix") pkgDeps then
      PosixThread
    else if List.mem (Libname.of_string "threads.vm") pkgDeps then
      VMThread
    else
      NoThreads
  in
  (* Create C library from regular C sources and cstubs combined *)
  let cfunlist =
    let csource_objs =
      List.map (fun x -> cstate.compilation_builddir_c </> o_from_cfile x) cstate.compilation_csources
    in
    let cstubs_objs =
      match (target.target_cstubs, target.target_name) with
      | Some cstubs, Name.Lib libname ->
          let autogen_dir = get_cstubs_autogen_dir libname in
          let c_lib_name = cstubs.cstubs_external_library_name in
          let c_stubs_file = fn (c_lib_name ^ "_stubs.c") in
          [ autogen_dir </> o_from_cfile c_stubs_file ]
      | _ -> []
    in
    let all_objs = csource_objs @ cstubs_objs in
    if all_objs <> [] then begin
      let clib_name = Target.get_target_clibname target in
      ignore (wait_for_files all_objs);
      if gconf.ocamlmklib then
        [ [ (fun () -> run_c_linking LinkingShared all_objs (cstate.compilation_builddir_c </> fn clib_name)) ] ]
      else
        let so_file = cstate.compilation_builddir_c </> fn (Utils.shared_lib_name clib_name) in
        let a_file = cstate.compilation_builddir_c </> fn (Utils.static_lib_name clib_name) in
        [
          [ (fun () -> run_c_linking LinkingShared all_objs so_file) ];
          [ (fun () -> run_ar a_file all_objs) ];
          [ (fun () -> run_ranlib a_file) ];
        ]
    end else
      []
  in
  let all_modes = get_all_modes target in
  let funlist =
    List.fold_left
      (fun flist (compiledType, compileOpt) ->
        let normal =
          link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs
            compiledType compileOpt false
        in
        let res =
          if is_lib target && compiledType = Native && Gconf.get_target_option_typed Library_plugin then
            link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs
              compiledType compileOpt true
            @ normal
          else
            normal
        in
        res @ flist)
      [] all_modes
  in
  if funlist <> [] then
    Scheduler.AddTask (task, cfunlist @ [ funlist ])
  else
    Scheduler.FinishTask task

let get_destination_files target =
  let all_modes = get_all_modes target in
  match target.Target.target_name with
  | Name.Lib libname -> List.map (fun (typ, opt) -> Libname.to_cmca typ opt libname) all_modes
  | Name.Exe _ | Name.Test _ | Name.Bench _ | Name.Example _ ->
      List.map
        (fun (ty, opt) -> Utils.to_exe_name opt ty (Target.get_target_dest_name target))
        all_modes

let sanity_check build_dir target =
  let files = get_destination_files target in
  let allOK =
    List.for_all
      (fun f ->
        let test = Filesystem.exists (build_dir </> f) in
        if not test then
          log Debug "warning: missing file %s" (fp_to_string (build_dir </> f));
        test)
      files
  in
  if not allOK then
    log Report "warning: some target file appears to be missing";
  ()

let check task_index task task_context dag =
  let _, target = Hashtbl.find task_context task in
  let buildDir = Dist.get_build_path (Dist.Target target.target_name) in
  let nb_step, nb_step_len = get_nb_step dag in
  log Report "[%*d of %d] Checking %s\n%!" nb_step_len task_index nb_step
    (fp_to_string buildDir);
  sanity_check buildDir target;
  Scheduler.FinishTask task

(* compile will process the compilation DAG,
 * which will compile all C sources and OCaml modules.
 *)
let compile (bstate : build_state) task_context dag =
  build_start_time := Unix.gettimeofday ();
  let taskdep = Helper.Timing.measure_time "Taskdep.init" (fun () -> Taskdep.init dag) in
  (* a compilation task has finished, terminate the process,
   * and process the result *)
  let schedule_finish (task, st) is_done =
    (match Process.terminate (task, st) with
    | Process.Success (_, warnings, duration) ->
        log Gconf.Debug "[TIMING] %s: %.3fs\n" (string_of_compile_step task) duration;
        (* TODO: store warnings for !isDone and print them if they are different when isDone *)
        if is_done then print_warnings warnings
    | Process.Failure er -> (
        match task with
        | CompileC _ -> raise (CCompilationFailed er)
        | _ -> raise (CompilationFailed er)));
    if is_done then
      Taskdep.mark_done taskdep task
  in

  let dispatch (task_index, task) =
    let t0 = Unix.gettimeofday () in
    let result = match task with
    | CompileC m -> compile_c task_index task m bstate task_context dag
    | CompileInterface m -> compile_module task_index task true m bstate task_context dag
    | CompileModule m -> compile_module task_index task false m bstate task_context dag
    | CompileDirectory m -> compile_directory task_index task m task_context dag
    | GenerateCstubsTypes lib -> generate_cstubs_types task_index task lib bstate task_context dag
    | GenerateCstubsFunctions lib ->
        generate_cstubs_functions task_index task lib bstate task_context dag
    | CompileCstubsC lib -> compile_cstubs_c task_index task lib bstate task_context dag
    | RunGenerateBlock gen_block -> run_generate_block task_index task gen_block bstate task_context dag
    | LinkTarget _ -> link task_index task bstate task_context dag
    | CheckTarget _ -> check task_index task task_context dag
    in
    let elapsed = Unix.gettimeofday () -. t0 in
    if elapsed > 0.01 then
      log Gconf.Debug "[TIMING] dispatch %s: %.3fs\n" (string_of_compile_step task) elapsed;
    result
  in

  let stat =
    Helper.Timing.measure_time "Scheduler.schedule" (fun () ->
        Scheduler.schedule gconf.parallel_jobs taskdep dispatch schedule_finish)
  in
  log Verbose "schedule finished: #processes=%d max_concurrency=%d\n"
    stat.Scheduler.nb_processes stat.Scheduler.max_runqueue;
  ()

let build_exe bstate exe =
  let target = Project.Executable.to_target exe in
  let modules = [ Hier.of_filename exe.Project.Executable.main ] in
  let task_context = Hashtbl.create initial_task_context_size in
  let build_dir = Dist.create_build (Dist.Target target.target_name) in
  let cstate = prepare_target bstate build_dir target modules in
  List.iter
    (fun n -> Hashtbl.add task_context n (cstate, target))
    (Dag.get_nodes cstate.compilation_dag);
  compile bstate task_context cstate.compilation_dag

let select_leaves children duplicate dag =
  let dup_set = Hashtbl.create (List.length duplicate) in
  List.iter (fun d -> Hashtbl.replace dup_set d ()) duplicate;
  let rec loop children =
    let good, bad = List.partition (fun a -> not (Hashtbl.mem dup_set a)) children in
    match bad with
    | [] -> good
    | _ ->
      let new_ = ref [] in
      List.iter
        (fun a ->
          let parents = Dag.get_parents dag a in
          List.iter (fun p -> new_ := p :: !new_) parents)
        bad;
      loop (!new_ @ good)
  in
  loop children

let build_dag bstate proj_file targets_dag =
  Helper.Timing.measure_time "build_dag (total)" (fun () ->
      let dag = Helper.Timing.measure_time "DAG initialization" (fun () -> Dag.init ()) in
      let task_context = Hashtbl.create initial_task_context_size in
      let taskdep = Taskdep.init targets_dag in
      let targets_deps = Hashtbl.create initial_task_context_size in

      (* Register all generated modules globally before preparing any target.
         This allows dependent targets to recognize generated modules. *)
      List.iter (fun lib ->
        let target = Project.Library.to_target lib in
        List.iter (fun (gen : Target.target_generate) ->
          let module_name = Hier.to_string gen.Target.generate_module in
          Hier.register_generated_module module_name
        ) target.Target.target_generates
      ) proj_file.Project.libs;

      let prepare_state target modules =
        let build_dir = Dist.create_build (Dist.Target target.target_name) in
        let cstate =
          Helper.Timing.measure_time "prepare_target" (fun () ->
              prepare_target bstate build_dir target modules)
        in
        List.iter
          (fun n -> Hashtbl.add task_context n (cstate, target))
          (Dag.get_nodes cstate.compilation_dag);
        let duplicate =
          Helper.Timing.measure_time "DAG merge" (fun () -> Dag.merge dag cstate.compilation_dag)
        in
        (cstate.compilation_dag, duplicate)
      in
      Helper.Timing.measure_time "target preparation loop" (fun () ->
          while not (Taskdep.is_complete taskdep) do
            match Taskdep.get_next taskdep with
            | None -> failwith "no free task in targets"
            | Some (_, ntask) ->
                log Verbose "preparing target %s\n%!" (Name.to_string ntask);
                let cur_dag, dups =
                  match ntask with
                  | Name.Exe name ->
                      let exe = Project.find_exe proj_file name in
                      prepare_state
                        (Project.Executable.to_target exe)
                        [ Hier.of_filename exe.Project.Executable.main ]
                  | Name.Lib name ->
                      let lib = Project.find_lib proj_file name in
                      let target = Project.Library.to_target lib in
                      (* Include generated modules from generate blocks - they belong to the library *)
                      let generated_modules = List.map (fun (g : Target.target_generate) ->
                        g.Target.generate_module
                      ) target.Target.target_generates in
                      prepare_state target (lib.Project.Library.modules @ generated_modules)
                  | Name.Bench name ->
                      let bench = Project.find_bench proj_file name in
                      prepare_state (Project.Bench.to_target bench)
                        [ Hier.of_filename bench.Project.Bench.main ]
                  | Name.Test name ->
                      let test = Project.find_test proj_file name in
                      prepare_state (Project.Test.to_target test)
                        [ Hier.of_filename test.Project.Test.main ]
                  | Name.Example name ->
                      let example = Project.find_example proj_file name in
                      prepare_state
                        (Project.Example.to_target example)
                        [ Hier.of_filename example.Project.Example.main ]
                in
                if Hashtbl.mem targets_deps ntask then begin
                  let children = Dag.get_leaves cur_dag in
                  let children = select_leaves children dups cur_dag in
                  let roots = Hashtbl.find targets_deps ntask in
                  List.iter
                    (fun child -> List.iter (fun root -> Dag.add_edge child root dag) roots)
                    children
                end;
                let roots = Dag.get_roots cur_dag in
                (* should be LinkTarget *)
                List.iter
                  (fun p -> Hashtbl.add targets_deps p roots)
                  (Dag.get_parents targets_dag ntask);
                Taskdep.mark_done taskdep ntask
          done);
      Helper.Timing.measure_time "compilation phase" (fun () -> compile bstate task_context dag))