(** {2 Command line} *)

let concurrency, verbose, debug, secondary, force_byte_compilation, static, build_dir =
  let build_dir = ref "_boot" in
  let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
  let concurrency = ref None in
  let verbose = ref false in
  let prog = Filename.basename Sys.argv.(0) in
  let debug = ref false in
  let secondary = ref false in
  let force_byte_compilation = ref false in
  let static = ref false in
  Arg.parse
    [ "-j", Int (fun n -> concurrency := Some n), "JOBS Concurrency"
    ; "--verbose", Set verbose, " Set the display mode"
    ; "--keep-generated-files", Unit ignore, " Keep generated files"
    ; "--debug", Set debug, " Enable various debugging options"
    ; "--secondary", Set secondary, " Use the secondary compiler installation"
    ; ( "--force-byte-compilation"
      , Set force_byte_compilation
      , " Force bytecode compilation even if ocamlopt is available" )
    ; "--static", Set static, " Build a static binary"
    ; "--boot-dir", Set_string build_dir, " Set the boot directory"
    ]
    anon
    (Printf.sprintf "Usage: %s <options>\nOptions are:" prog);
  !concurrency, !verbose, !debug, !secondary, !force_byte_compilation, !static, !build_dir
;;

(** {2 General configuration} *)

type task =
  { target : string * string
  ; external_libraries : string list
  ; local_libraries : Libs.library list
  }

let task =
  { target = "dune", "bin/main.ml"
  ; external_libraries = Libs.external_libraries
  ; local_libraries = Libs.local_libraries
  }
;;

(** {2 Utility functions} *)

open StdLabels
open Printf

module String = struct
  include String
  module Set = Set.Make (String)
  module Map = Map.Make (String)

  let is_suffix t ~suffix = Filename.check_suffix t suffix

  let is_prefix t ~prefix =
    let len_s = length t
    and len_pre = length prefix in
    let rec aux i =
      if i = len_pre
      then true
      else if unsafe_get t i <> unsafe_get prefix i
      then false
      else aux (i + 1)
    in
    len_s >= len_pre && aux 0
  ;;
end

module List = struct
  include List

  let partition_map_skip t ~f =
    let rec loop l m r = function
      | [] -> l, m, r
      | x :: xs ->
        (match f x with
         | `Skip -> loop l m r xs
         | `Left x -> loop (x :: l) m r xs
         | `Middle x -> loop l (x :: m) r xs
         | `Right x -> loop l m (x :: r) xs)
    in
    let l, m, r = loop [] [] [] t in
    rev l, rev m, rev r
  ;;

  let rec filter_map l ~f =
    match l with
    | [] -> []
    | x :: l ->
      (match f x with
       | None -> filter_map l ~f
       | Some x -> x :: filter_map l ~f)
  ;;
end

let ( ^/ ) = Filename.concat

let fatal fmt =
  ksprintf
    (fun s ->
       prerr_endline s;
       exit 2)
    fmt
;;

module Status_line = struct
  let num_jobs = ref 0
  let num_jobs_finished = ref 0
  let displayed = ref ""

  let display_status_line =
    Unix.(isatty stdout)
    ||
    match Sys.getenv "INSIDE_EMACS" with
    | (_ : string) -> true
    | exception Not_found -> false
  ;;

  let update jobs =
    if display_status_line && !num_jobs > 0
    then (
      let new_displayed =
        sprintf "Done: %d/%d (jobs: %d)" !num_jobs_finished !num_jobs jobs
      in
      Printf.printf "\r%*s\r%s%!" (String.length !displayed) "" new_displayed;
      displayed := new_displayed)
  ;;

  let clear () = Printf.printf "\r*s\r%!"
  let () = at_exit (fun () -> Printf.printf "\r%*s\r" (String.length !displayed) "")
end

(* Return a sorted list of entries in [path] as [path/entry] *)
let readdir path =
  Sys.readdir path
  |> Array.to_list
  |> List.map ~f:(fun entry -> path ^/ entry)
  |> List.sort ~cmp:String.compare
;;

let open_out file =
  if Sys.file_exists file then fatal "%s already exists" file;
  open_out file
;;

let input_lines ic =
  let rec loop ic acc =
    match input_line ic with
    | line -> loop ic (line :: acc)
    | exception End_of_file -> List.rev acc
  in
  loop ic []
;;

let read_lines fn =
  let ic = open_in fn in
  let lines = input_lines ic in
  close_in ic;
  lines
;;

let read_file fn =
  let ic = open_in_bin fn in
  let s = really_input_string ic (in_channel_length ic) in
  close_in ic;
  s
;;

let split_lines s =
  let rec loop ~last_is_cr ~acc i j =
    if j = String.length s
    then (
      let acc =
        if j = i || (j = i + 1 && last_is_cr)
        then acc
        else String.sub s ~pos:i ~len:(j - i) :: acc
      in
      List.rev acc)
    else (
      match s.[j] with
      | '\r' -> loop ~last_is_cr:true ~acc i (j + 1)
      | '\n' ->
        let line =
          let len = if last_is_cr then j - i - 1 else j - i in
          String.sub s ~pos:i ~len
        in
        loop ~acc:(line :: acc) (j + 1) (j + 1) ~last_is_cr:false
      | _ -> loop ~acc i (j + 1) ~last_is_cr:false)
  in
  loop ~acc:[] 0 0 ~last_is_cr:false
;;

let do_then_copy ~f a b =
  if Sys.file_exists b then fatal "%s already exists" b;
  let ic = open_in_bin a in
  let len = in_channel_length ic in
  let s = really_input_string ic len in
  close_in ic;
  let oc = open_out_bin b in
  f oc;
  output_string oc s;
  close_out oc
;;

(* copy a file - fails if the file exists *)
let copy a b = do_then_copy ~f:(fun _ -> ()) a b

(* copy a file and insert a header - fails if the file exists *)
let copy_with_header ~header a b = do_then_copy ~f:(fun oc -> output_string oc header) a b

(* copy a file and insert a directive - fails if the file exists *)
let copy_with_directive ~directive a b =
  do_then_copy ~f:(fun oc -> fprintf oc "#%s 1 %S\n" directive a) a b
;;

let path_sep = if Sys.win32 then ';' else ':'

let split_path s =
  let rec loop i j =
    if j = String.length s
    then [ String.sub s ~pos:i ~len:(j - i) ]
    else if s.[j] = path_sep
    then String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
    else loop i (j + 1)
  in
  loop 0 0
;;

let path =
  match Sys.getenv "PATH" with
  | exception Not_found -> []
  | s -> split_path s
;;

let find_prog ~f =
  let rec search = function
    | [] -> None
    | dir :: rest ->
      (match f dir with
       | None -> search rest
       | Some fn -> Some (dir, fn))
  in
  search path
;;

let exe = if Sys.win32 then ".exe" else ""

(** {2 Concurrency level} *)

let concurrency =
  let try_run_and_capture_line (prog, args) =
    match
      find_prog ~f:(fun dir -> if Sys.file_exists (dir ^/ prog) then Some prog else None)
    with
    | None -> None
    | Some (dir, prog) ->
      let path = dir ^/ prog in
      let args = Array.of_list @@ (path :: args) in
      let ic, oc, ec = Unix.open_process_args_full path args (Unix.environment ()) in
      let line =
        match input_line ic with
        | s -> Some s
        | exception End_of_file -> None
      in
      (match Unix.close_process_full (ic, oc, ec), line with
       | WEXITED 0, Some s -> Some s
       | _ -> None)
  in
  match concurrency with
  | Some n -> n
  | None ->
    (* If no [-j] was given, try to autodetect the number of processors *)
    if Sys.win32
    then (
      match Sys.getenv_opt "NUMBER_OF_PROCESSORS" with
      | None -> 1
      | Some s ->
        (match int_of_string s with
         | exception _ -> 1
         | n -> n))
    else (
      let commands =
        [ "nproc", []
        ; "getconf", [ "_NPROCESSORS_ONLN" ]
        ; "getconf", [ "NPROCESSORS_ONLN" ]
        ]
      in
      let rec loop = function
        | [] -> 1
        | cmd :: rest ->
          (match try_run_and_capture_line cmd with
           | None -> loop rest
           | Some s ->
             (match int_of_string (String.trim s) with
              | n -> n
              | exception _ -> loop rest))
      in
      loop commands)
;;

(** {2 Fibers} *)

module Fiber : sig
  (** Fibers *)

  (** This module is similar to the one in [../src/fiber] except that it is much
      less optimised and much easier to understand. You should look at the
      documentation of the other module to understand the API. *)

  type 'a t

  val return : 'a -> 'a t

  module O : sig
    val ( >>> ) : unit t -> 'a t -> 'a t
    val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
    val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
  end

  module Future : sig
      type 'a fiber
      type 'a t

      val wait : 'a t -> 'a fiber
    end
    with type 'a fiber := 'a t

  val fork : (unit -> 'a t) -> 'a Future.t t
  val fork_and_join : (unit -> 'a t) -> (unit -> 'b t) -> ('a * 'b) t
  val fork_and_join_unit : (unit -> unit t) -> (unit -> 'a t) -> 'a t
  val parallel_map : 'a list -> f:('a -> 'b t) -> 'b list t
  val parallel_iter : 'a list -> f:('a -> unit t) -> unit t

  module Process : sig
    val run : ?cwd:string -> string -> string list -> unit t
    val run_and_capture : ?cwd:string -> string -> string list -> string t
    val try_run_and_capture : ?cwd:string -> string -> string list -> string option t
  end

  val run : 'a t -> 'a
end = struct
  open MoreLabels

  type 'a t = ('a -> unit) -> unit

  let return x k = k x

  module O = struct
    let ( >>> ) a b k = a (fun () -> b k)
    let ( >>= ) t f k = t (fun x -> f x k)
    let ( >>| ) t f k = t (fun x -> k (f x))
  end

  open O

  let both a b = a >>= fun a -> b >>= fun b -> return (a, b)

  module Ivar = struct
    type 'a state =
      | Full of 'a
      | Empty of ('a -> unit) Queue.t

    type 'a t = { mutable state : 'a state }

    let create () = { state = Empty (Queue.create ()) }

    let fill t x =
      match t.state with
      | Full _ -> failwith "Fiber.Ivar.fill"
      | Empty q ->
        t.state <- Full x;
        Queue.iter (fun f -> f x) q
    ;;

    let read t k =
      match t.state with
      | Full x -> k x
      | Empty q -> Queue.push k q
    ;;
  end

  module Future = struct
    type 'a t = 'a Ivar.t

    let wait = Ivar.read
  end

  let fork f k =
    let ivar = Ivar.create () in
    f () (fun x -> Ivar.fill ivar x);
    k ivar
  ;;

  let fork_and_join f g =
    fork f >>= fun a -> fork g >>= fun b -> both (Future.wait a) (Future.wait b)
  ;;

  let fork_and_join_unit f g =
    fork f >>= fun a -> fork g >>= fun b -> Future.wait a >>> Future.wait b
  ;;

  let rec parallel_map l ~f =
    match l with
    | [] -> return []
    | x :: l ->
      fork (fun () -> f x)
      >>= fun future ->
      parallel_map l ~f >>= fun l -> Future.wait future >>= fun x -> return (x :: l)
  ;;

  let rec parallel_iter l ~f =
    match l with
    | [] -> return ()
    | x :: l ->
      fork (fun () -> f x)
      >>= fun future -> parallel_iter l ~f >>= fun () -> Future.wait future
  ;;

  module Temp = struct
    module Files = Set.Make (String)

    let tmp_files = ref Files.empty

    let () =
      at_exit (fun () ->
        let fns = !tmp_files in
        tmp_files := Files.empty;
        Files.iter fns ~f:(fun fn ->
          try Sys.remove fn with
          | _ -> ()))
    ;;

    let file prefix suffix =
      let fn = Filename.temp_file prefix suffix in
      tmp_files := Files.add fn !tmp_files;
      fn
    ;;

    let destroy_file fn =
      (try Sys.remove fn with
       | _ -> ());
      tmp_files := Files.remove fn !tmp_files
    ;;
  end

  module Process = struct
    let running = Hashtbl.create concurrency

    exception Finished of int * Unix.process_status

    let rec wait_win32 () =
      match
        Hashtbl.iter running ~f:(fun ~key:pid ~data:_ ->
          let pid, status = Unix.waitpid [ WNOHANG ] pid in
          if pid <> 0 then raise_notrace (Finished (pid, status)))
      with
      | () ->
        ignore (Unix.select [] [] [] 0.001);
        wait_win32 ()
      | exception Finished (pid, status) -> pid, status
    ;;

    let wait = if Sys.win32 then wait_win32 else Unix.wait
    let waiting_for_slot = Queue.create ()

    let throttle () =
      if Hashtbl.length running >= concurrency
      then (
        let ivar = Ivar.create () in
        Queue.push ivar waiting_for_slot;
        Ivar.read ivar)
      else return ()
    ;;

    let restart_throttled () =
      while
        Hashtbl.length running < concurrency && not (Queue.is_empty waiting_for_slot)
      do
        Ivar.fill (Queue.pop waiting_for_slot) ()
      done
    ;;

    let open_temp_file () =
      let out = Temp.file "duneboot-" ".output" in
      let fd =
        Unix.openfile out [ O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE; O_CLOEXEC ] 0o666
      in
      out, fd
    ;;

    let read_temp fn =
      let s = read_file fn in
      Temp.destroy_file fn;
      s
    ;;

    let initial_cwd = Sys.getcwd ()

    let run_process ?cwd prog args ~split =
      throttle ()
      >>= fun () ->
      let stdout_fn, stdout_fd = open_temp_file () in
      let stderr_fn, stderr_fd =
        if split then open_temp_file () else stdout_fn, stdout_fd
      in
      (match cwd with
       | Some x -> Sys.chdir x
       | None -> ());
      let pid =
        Unix.create_process
          prog
          (Array.of_list (prog :: args))
          Unix.stdin
          stdout_fd
          stderr_fd
      in
      (match cwd with
       | Some _ -> Sys.chdir initial_cwd
       | None -> ());
      Unix.close stdout_fd;
      if split then Unix.close stderr_fd;
      let ivar = Ivar.create () in
      Hashtbl.add running ~key:pid ~data:ivar;
      Ivar.read ivar
      >>= fun (status : Unix.process_status) ->
      let stdout_s = read_temp stdout_fn in
      let stderr_s = if split then read_temp stderr_fn else stdout_s in
      if stderr_s <> "" || status <> WEXITED 0 || verbose
      then (
        let cmdline = String.concat ~sep:" " (prog :: args) in
        let cmdline =
          match cwd with
          | Some x -> sprintf "cd %s && %s" x cmdline
          | None -> cmdline
        in
        Status_line.clear ();
        prerr_endline cmdline;
        prerr_string stderr_s;
        flush stderr);
      match status with
      | WEXITED 0 -> return (Ok stdout_s)
      | WEXITED n -> return (Error n)
      | WSIGNALED _ -> return (Error 255)
      | WSTOPPED _ -> assert false
    ;;

    let run ?cwd prog args =
      run_process ?cwd prog args ~split:false
      >>| function
      | Ok _ -> ()
      | Error n -> exit n
    ;;

    let run_and_capture ?cwd prog args =
      run_process ?cwd prog args ~split:true
      >>| function
      | Ok x -> x
      | Error n -> exit n
    ;;

    let try_run_and_capture ?cwd prog args =
      run_process ?cwd prog args ~split:true
      >>| function
      | Ok x -> Some x
      | Error _ -> None
    ;;
  end

  let run t =
    let result = ref None in
    t (fun x -> result := Some x);
    let rec loop () =
      if Hashtbl.length Process.running > 0
      then (
        Status_line.update (Hashtbl.length Process.running);
        let pid, status = Process.wait () in
        let ivar = Hashtbl.find Process.running pid in
        Hashtbl.remove Process.running pid;
        Ivar.fill ivar status;
        Process.restart_throttled ();
        loop ())
      else (
        match !result with
        | Some x -> x
        | None -> fatal "bootstrap got stuck!")
    in
    loop ()
  ;;
end

open Fiber.O
module Process = Fiber.Process

(** {2 OCaml tools} *)

module Mode = struct
  type t =
    | Byte
    | Native
end

module Config : sig
  val compiler : string
  val ocamldep : string
  val ocamllex : string
  val ocamlyacc : string
  val mode : Mode.t
  val ocaml_archive_ext : string
  val ocaml_config : unit -> string String.Map.t Fiber.t
  val output_complete_obj_arg : string
  val unix_library_flags : string list
end = struct
  let ocaml_version = Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> a, b)
  let prog_not_found prog = fatal "Program %s not found in PATH" prog

  let best_prog dir prog =
    let fn = dir ^/ prog ^ ".opt" ^ exe in
    if Sys.file_exists fn
    then Some fn
    else (
      let fn = dir ^/ prog ^ exe in
      if Sys.file_exists fn then Some fn else None)
  ;;

  let find_prog prog = find_prog ~f:(fun dir -> best_prog dir prog)

  let get_prog dir prog =
    match best_prog dir prog with
    | None -> prog_not_found prog
    | Some fn -> fn
  ;;

  let bin_dir, ocamlc =
    if secondary
    then (
      let s =
        Fiber.run
          (Process.run_and_capture
             "ocamlfind"
             [ "-toolchain"; "secondary"; "query"; "ocaml" ])
      in
      match split_lines s with
      | [] | _ :: _ :: _ -> fatal "Unexpected output locating secondary compiler"
      | [ bin_dir ] ->
        (match best_prog bin_dir "ocamlc" with
         | None -> fatal "Failed to locate secondary ocamlc"
         | Some x -> bin_dir, x))
    else (
      match find_prog "ocamlc" with
      | None -> prog_not_found "ocamlc"
      | Some x -> x)
  ;;

  let ocamlyacc = get_prog bin_dir "ocamlyacc"
  let ocamllex = get_prog bin_dir "ocamllex"
  let ocamldep = get_prog bin_dir "ocamldep"

  let compiler, mode, ocaml_archive_ext =
    match force_byte_compilation, best_prog bin_dir "ocamlopt" with
    | true, _ | _, None -> ocamlc, Mode.Byte, ".cma"
    | false, Some path -> path, Mode.Native, ".cmxa"
  ;;

  let ocaml_config () =
    Process.run_and_capture ocamlc [ "-config" ]
    >>| fun s ->
    List.fold_left (split_lines s) ~init:String.Map.empty ~f:(fun acc line ->
      match Scanf.sscanf line "%[^:]: %s" (fun k v -> k, v) with
      | k, v -> String.Map.add k v acc
      | exception _ ->
        fatal "invalid line in output of 'ocamlc -config': %s" (String.escaped line))
  ;;

  let output_complete_obj_arg =
    if ocaml_version < (4, 10) then "-custom" else "-output-complete-exe"
  ;;

  let unix_library_flags = if ocaml_version >= (5, 0) then [ "-I"; "+unix" ] else []
end

let insert_header fn ~header =
  match header with
  | "" -> ()
  | h ->
    let s = read_file fn in
    let oc = open_out_bin fn in
    output_string oc h;
    output_string oc s;
    close_out oc
;;

let copy_lexer ~header src dst =
  let dst = Filename.remove_extension dst ^ ".ml" in
  Process.run Config.ocamllex [ "-q"; "-o"; dst; src ]
  >>| fun () -> insert_header dst ~header
;;

let copy_parser ~header src dst =
  let dst = Filename.remove_extension dst in
  Process.run Config.ocamlyacc [ "-b"; dst; src ]
  >>| fun () ->
  insert_header (dst ^ ".ml") ~header;
  insert_header (dst ^ ".mli") ~header
;;

(** {2 Handling of the dune-build-info library} *)

(** {2 Preparation of library files} *)
module Build_info = struct
  let get_version () =
    let from_dune_project =
      match read_lines "dune-project" with
      | exception _ -> None
      | lines ->
        let rec loop = function
          | [] -> None
          | line :: lines ->
            (match Scanf.sscanf line "(version %[^)])" (fun v -> v) with
             | exception _ -> loop lines
             | v -> Some v)
        in
        loop lines
    in
    match from_dune_project with
    | Some _ -> Fiber.return from_dune_project
    | None ->
      if not (Sys.file_exists ".git")
      then Fiber.return None
      else
        Process.try_run_and_capture
          "git"
          [ "describe"; "--always"; "--dirty"; "--abbrev=7" ]
        >>| (function
         | Some s -> Some (String.trim s)
         | None -> None)
  ;;

  let gen_data_module oc =
    let pr fmt = fprintf oc fmt in
    let prlist name l ~f =
      match l with
      | [] -> pr "let %s = []\n" name
      | x :: l ->
        pr "let %s =\n" name;
        pr "  [ ";
        f x;
        List.iter l ~f:(fun x ->
          pr "  ; ";
          f x);
        pr "  ]\n"
    in
    get_version ()
    >>| fun version ->
    pr
      "let version = %s\n"
      (match version with
       | None -> "None"
       | Some v -> sprintf "Some %S" v);
    pr "\n";
    let libs =
      List.map task.local_libraries ~f:(fun (lib : Libs.library) -> lib.path, "version")
      @ List.map task.external_libraries ~f:(fun name ->
        name, {|Some "[distributed with OCaml]"|})
      |> List.sort ~cmp:(fun (a, _) (b, _) -> String.compare a b)
    in
    prlist "statically_linked_libraries" libs ~f:(fun (name, v) -> pr "%S, %s\n" name v)
  ;;
end

(* module OCaml_file = struct module Kind = struct type t = Impl | Intf end

   type t = { kind : Kind.t ; module_name = end *)

module Library = struct
  module File_kind = struct
    type asm =
      { syntax : [ `Gas | `Intel ]
      ; arch : [ `Amd64 ] option
      ; os : [ `Win | `Unix ] option
      ; assembler : [ `C_comp | `Msvc_asm ]
      }

    type c =
      { arch : [ `Arm64 | `X86 ] option
      ; flags : string list
      }

    type t =
      | Header
      | C of c
      | Asm of asm
      | Ml
      | Mli
      | Mll
      | Mly

    let analyse file =
      let fn = Filename.basename file in
      let i =
        try String.index fn '.' with
        | Not_found -> String.length fn
      in
      match String.sub fn ~pos:i ~len:(String.length fn - i) with
      | (".S" | ".asm") as ext ->
        let syntax = if ext = ".S" then `Gas else `Intel in
        let os, arch, assembler =
          let fn = Filename.remove_extension fn in
          let check suffix = String.is_suffix fn ~suffix in
          if check "x86-64_unix"
          then Some `Unix, Some `Amd64, `C_comp
          else if check "x86-64_windows_gnu"
          then Some `Win, Some `Amd64, `C_comp
          else if check "x86-64_windows_msvc"
          then Some `Win, Some `Amd64, `Msvc_asm
          else None, None, `C_comp
        in
        Some (Asm { syntax; arch; os; assembler })
      | ".c" ->
        let arch, flags =
          let fn = Filename.remove_extension fn in
          let check suffix = String.is_suffix fn ~suffix in
          let x86 gnu _msvc =
            (* CR rgrinberg: select msvc flags on windows *)
            Some `X86, gnu
          in
          if check "_sse2"
          then x86 [ "-msse2" ] [ "/arch:SSE2" ]
          else if check "_sse41"
          then x86 [ "-msse4.1" ] [ "/arch:AVX" ]
          else if check "_avx2"
          then x86 [ "-mavx2" ] [ "/arch:AVX2" ]
          else if check "_avx512"
          then x86 [ "-mavx512f"; "-mavx512vl"; "-mavx512bw" ] [ "/arch:AVX512" ]
          else if String.is_suffix fn ~suffix:"_neon"
          then Some `Arm64, []
          else None, []
        in
        Some (C { arch; flags })
      | ".h" -> Some Header
      | ".ml" -> Some Ml
      | ".mli" -> Some Mli
      | ".mll" -> Some Mll
      | ".mly" -> Some Mly
      | ".defaults.ml" ->
        let fn' = String.sub fn ~pos:0 ~len:i ^ ".ml" in
        let dn = Filename.dirname file in
        if Sys.file_exists (dn ^/ fn') then None else Some Ml
      | _ -> None
    ;;
  end

  type source =
    { file : string
    ; kind : File_kind.t
    }

  type c_file =
    { name : string
    ; flags : string list
    }

  type asm_file =
    { assembler : [ `C_comp | `Msvc_asm ]
    ; flags : string list
    ; out_file : string
    }

  module Wrapper = struct
    type t =
      { toplevel_module : string
      ; alias_module : string
      }

    let make ~namespace ~modules =
      match namespace with
      | None -> None
      | Some namespace ->
        let namespace = String.capitalize_ascii namespace in
        if String.Set.equal modules (String.Set.singleton namespace)
        then None
        else if String.Set.mem namespace modules
        then Some { toplevel_module = namespace; alias_module = namespace ^ "__" }
        else Some { toplevel_module = namespace; alias_module = namespace }
    ;;

    let mangle_filename t ({ file; kind } : source) =
      let base = Filename.basename file in
      match kind with
      | Asm _ | C _ | Header -> base
      | Mll | Mly | Ml | Mli ->
        let ext =
          match kind with
          | Mli -> ".mli"
          | _ -> ".ml"
        in
        let base =
          String.sub base ~pos:0 ~len:(String.index base '.') |> String.uncapitalize_ascii
        in
        (match t with
         | None -> base ^ ext
         | Some t ->
           if String.capitalize_ascii base = t.toplevel_module
           then base ^ ext
           else (
             let base = String.capitalize_ascii base in
             String.uncapitalize_ascii t.toplevel_module ^ "__" ^ base ^ ext))
    ;;

    let header t =
      match t with
      | None -> ""
      | Some t -> sprintf "open! %s\n" t.alias_module
    ;;

    let generate_wrapper t modules =
      match t with
      | None -> None
      | Some t ->
        let fn = String.uncapitalize_ascii t.alias_module ^ ".ml" in
        let oc = open_out (build_dir ^/ fn) in
        String.Set.iter
          (fun m ->
             if m <> t.toplevel_module
             then fprintf oc "module %s = %s__%s\n" m t.toplevel_module m)
          modules;
        close_out oc;
        Some fn
    ;;
  end

  (* Collect source files *)
  let scan ~dir ~scan_subdirs =
    let rec loop files acc =
      match files with
      | [] -> acc
      | file :: files ->
        let acc =
          if Sys.is_directory file
          then if scan_subdirs then loop (readdir file) acc else acc
          else (
            match File_kind.analyse file with
            | Some kind -> { file; kind } :: acc
            | None -> acc)
        in
        loop files acc
    in
    loop (readdir dir) []
  ;;

  type t =
    { ocaml_files : string list
    ; alias_file : string option
    ; c_files : c_file list
    ; asm_files : asm_file list
    }

  let keep_asm
        { File_kind.syntax; arch; os; assembler = _ }
        ~ccomp_type
        ~architecture
        ~os_type
    =
    (match os with
     | Some `Unix -> String.equal os_type "Unix"
     | Some `Win -> String.equal os_type "Win32"
     | None -> true)
    && (match syntax, ccomp_type with
        | `Intel, "msvc" -> true
        | `Gas, "msvc" -> false
        | `Gas, _ -> true
        | `Intel, _ -> false)
    &&
    match arch, architecture with
    | None, _ -> true
    | Some `Amd64, "amd64" -> true
    | Some `Amd64, _ -> false
  ;;

  let keep_c { File_kind.arch; flags = _ } ~architecture =
    match arch with
    | None -> true
    | Some `Arm64 -> architecture = "arm64"
    | Some `X86 -> architecture = "amd64" || architecture = "x86_64"
  ;;

  let process
        { Libs.path = dir
        ; main_module_name = namespace
        ; include_subdirs_unqualified = scan_subdirs
        ; special_builtin_support = build_info_module
        }
        ~ocaml_config
        ~word_size
        ~os_type
    =
    let files = scan ~dir ~scan_subdirs in
    let modules =
      let modules =
        List.fold_left files ~init:String.Set.empty ~f:(fun acc { file = fn; kind } ->
          match (kind : File_kind.t) with
          | Asm _ | Header | C _ -> acc
          | Ml | Mli | Mll | Mly ->
            let module_name =
              let fn = Filename.basename fn in
              String.sub fn ~pos:0 ~len:(String.index fn '.') |> String.capitalize_ascii
            in
            String.Set.add module_name acc)
      in
      match build_info_module with
      | None -> modules
      | Some m -> String.Set.add (String.capitalize_ascii m) modules
    in
    let wrapper = Wrapper.make ~namespace ~modules in
    let header = Wrapper.header wrapper in
    Fiber.fork_and_join
      (fun () ->
         Fiber.parallel_map files ~f:(fun ({ file = fn; kind } as source) ->
           let mangled = Wrapper.mangle_filename wrapper source in
           let dst = build_dir ^/ mangled in
           (match kind with
            | Asm _ ->
              copy fn dst;
              Fiber.return [ mangled ]
            | Header | C _ ->
              copy_with_directive ~directive:"line" fn dst;
              Fiber.return [ mangled ]
            | Ml | Mli ->
              copy_with_header ~header fn dst;
              Fiber.return [ mangled ]
            | Mll -> copy_lexer fn dst ~header >>> Fiber.return [ mangled ]
            | Mly ->
              (* CR rgrinberg: what if the parser already has an mli? *)
              copy_parser fn dst ~header >>> Fiber.return [ mangled; mangled ^ "i" ])
           >>| function
           | mangled -> List.map mangled ~f:(fun m -> source, m)))
      (fun () ->
         match build_info_module with
         | None -> Fiber.return None
         | Some m ->
           let src =
             let fn = String.uncapitalize_ascii m ^ ".ml" in
             { file = fn; kind = Ml }
           in
           let mangled = Wrapper.mangle_filename wrapper src in
           let oc = open_out (build_dir ^/ mangled) in
           Build_info.gen_data_module oc
           >>| fun () ->
           close_out oc;
           Some (src, mangled))
    >>| fun (files, build_info_file) ->
    let alias_file = Wrapper.generate_wrapper wrapper modules in
    let c_files, ocaml_files, asm_files =
      let files =
        let files = List.concat files in
        match build_info_file with
        | None -> files
        | Some fn -> fn :: files
      in
      let ext_obj =
        try String.Map.find "ext_obj" ocaml_config with
        | Not_found -> ".o"
      in
      let ccomp_type = String.Map.find "ccomp_type" ocaml_config in
      let architecture = String.Map.find "architecture" ocaml_config in
      List.partition_map_skip files ~f:(fun (src, fn) ->
        match src.kind with
        | C c ->
          if keep_c c ~architecture
          then (
            let extra_flags =
              if String.is_prefix ~prefix:"blake3_" fn
              then
                if String.equal os_type "Cygwin" || String.equal word_size "32"
                then
                  [ "-DBLAKE3_NO_SSE2"
                  ; "-DBLAKE3_NO_SSE41"
                  ; "-DBLAKE3_NO_AVX2"
                  ; "-DBLAKE3_NO_AVX512"
                  ]
                else []
              else []
            in
            `Left { flags = extra_flags @ c.flags; name = fn })
          else `Skip
        | Ml | Mli | Mly | Mll -> `Middle fn
        | Header -> `Skip
        | Asm asm ->
          if keep_asm asm ~ccomp_type ~architecture ~os_type
          then (
            let out_file = Filename.chop_extension fn ^ ext_obj in
            `Right
              { flags =
                  (match asm.assembler with
                   | `C_comp -> [ "-c"; fn; "-o"; out_file ]
                   | `Msvc_asm -> [ "/nologo"; "/quiet"; "/Fo" ^ out_file; "/c"; fn ])
              ; assembler = asm.assembler
              ; out_file
              })
          else `Skip)
    in
    { ocaml_files; alias_file; c_files; asm_files }
  ;;
end

let ocamldep args =
  Process.run_and_capture Config.ocamldep ("-modules" :: args) ~cwd:build_dir
  >>| fun s ->
  List.map (split_lines s) ~f:(fun line ->
    let colon = String.index line ':' in
    let filename = String.sub line ~pos:0 ~len:colon in
    let modules =
      if colon = String.length line - 1
      then []
      else (
        let modules =
          String.sub line ~pos:(colon + 2) ~len:(String.length line - colon - 2)
        in
        String.split_on_char ~sep:' ' modules)
    in
    filename, modules)
  |> List.sort ~cmp:compare
;;

let mk_flags arg l = List.map l ~f:(fun m -> [ arg; m ]) |> List.flatten

let convert_dependencies ~all_source_files (file, dependencies) =
  let is_mli = Filename.check_suffix file ".mli" in
  let convert_module module_name =
    let filename = String.uncapitalize_ascii module_name in
    if filename = Filename.chop_extension file
    then (* Self-reference *)
      None
    else if String.Set.mem (filename ^ ".mli") all_source_files
    then
      if (not is_mli) && String.Set.mem (filename ^ ".ml") all_source_files
      then
        (* We need to build the .ml for inlining info *)
        Some [ filename ^ ".mli"; filename ^ ".ml" ]
      else (* .mli files never depend on .ml files *)
        Some [ filename ^ ".mli" ]
    else if String.Set.mem (filename ^ ".ml") all_source_files
    then
      (* If there's no .mli, then we must always depend on the .ml *)
      Some [ filename ^ ".ml" ]
    else (* This is a module coming from an external library *)
      None
  in
  let dependencies =
    let dependencies = List.concat (List.filter_map ~f:convert_module dependencies) in
    (* .ml depends on .mli, if it exists *)
    if (not is_mli) && String.Set.mem (file ^ "i") all_source_files
    then (file ^ "i") :: dependencies
    else dependencies
  in
  file, dependencies
;;

let write_args file args =
  let ch = open_out (build_dir ^/ file) in
  output_string ch (String.concat ~sep:"\n" args);
  close_out ch
;;

let get_dependencies libraries =
  let alias_files =
    List.fold_left libraries ~init:[] ~f:(fun acc (lib : Library.t) ->
      match lib.alias_file with
      | None -> acc
      | Some fn -> fn :: acc)
  in
  let all_source_files =
    List.map ~f:(fun (lib : Library.t) -> lib.ocaml_files) libraries |> List.concat
  in
  write_args "source_files" all_source_files;
  ocamldep (mk_flags "-map" alias_files @ [ "-args"; "source_files" ])
  >>| fun dependencies ->
  let all_source_files =
    List.fold_left
      alias_files
      ~init:(String.Set.of_list all_source_files)
      ~f:(fun acc fn -> String.Set.add fn acc)
  in
  let deps =
    List.rev_append
      ((* Alias files have no dependencies *)
       List.rev_map
         alias_files
         ~f:(fun fn -> fn, []))
      (List.rev_map dependencies ~f:(convert_dependencies ~all_source_files))
  in
  if debug
  then (
    eprintf "***** Dependencies *****\n";
    List.iter deps ~f:(fun (fn, deps) ->
      eprintf "%s: %s\n" fn (String.concat deps ~sep:" "));
    eprintf "**********\n");
  deps
;;

let assemble_libraries
      { local_libraries; target = _, main; _ }
      ~ocaml_config
      ~word_size
      ~os_type
  =
  (* In order to assemble all the sources in one place, the executables
       modules are also put in a namespace *)
  let task_lib =
    let dir = Filename.dirname main in
    let namespace =
      String.capitalize_ascii (Filename.chop_extension (Filename.basename main))
    in
    { Libs.path = dir
    ; main_module_name = Some namespace
    ; include_subdirs_unqualified = true
    ; special_builtin_support = None
    }
  in
  local_libraries @ [ task_lib ]
  |> Fiber.parallel_map ~f:(Library.process ~ocaml_config ~word_size ~os_type)
;;

type status =
  | Not_started of (unit -> unit Fiber.t)
  | Initializing
  | Started of unit Fiber.Future.t

let resolve_externals external_libraries =
  let external_libraries, external_includes =
    let convert = function
      | "threads" -> "threads" ^ Config.ocaml_archive_ext, [ "-I"; "+threads" ]
      | "unix" -> "unix" ^ Config.ocaml_archive_ext, Config.unix_library_flags
      | s -> fatal "unhandled external library %s" s
    in
    List.map ~f:convert external_libraries |> List.split
  in
  let external_includes = List.concat external_includes in
  external_libraries, external_includes
;;

let sort_files dependencies ~main =
  let deps_by_file = Hashtbl.create (List.length dependencies) in
  List.iter dependencies ~f:(fun (file, deps) -> Hashtbl.add deps_by_file file deps);
  let seen = ref String.Set.empty in
  let res = ref [] in
  let rec loop file =
    if not (String.Set.mem file !seen)
    then (
      seen := String.Set.add file !seen;
      List.iter (Hashtbl.find deps_by_file file) ~f:loop;
      res := file :: !res)
  in
  loop (Filename.basename main);
  List.rev !res
;;

let common_build_args name ~external_includes ~external_libraries =
  List.concat
    [ [ "-o"; name ^ ".exe"; "-g" ]
    ; (match Config.mode with
       | Byte -> [ Config.output_complete_obj_arg ]
       | Native -> [])
    ; external_includes
    ; external_libraries
    ]
;;

let allow_unstable_sources = [ "-alert"; "-unstable" ]

let ocaml_warnings =
  let warnings =
    [ (* Warning 49 [no-cmi-file]: no cmi file was found in path for module *)
      "-49"
    ; (* Warning 23: all the fields are explicitly listed in this record: the
        'with' clause is useless. 

         In order to stay version independent, we use a trick with `with` by
         creating a dummy value and filling in the fields available in every
         OCaml version. forced_major_collections is the one missing in versions
         older than 4.12. We therefore disable warning 23 for our purposes. *)
      "-23"
    ; (* Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear
        in this context

        Any .mli files that begin wtih [@@@alert] will cause the compiler to
        emit warning 53 due to the way we alias modules with an `open!`. It may
        be possible to use the command line flag `-open` instead, however this
        complicates dependency tracking so disabling this warning instead is
        suitable for our purposes. *)
      "-53"
    ]
  in
  [ "-w"; String.concat ~sep:"" warnings ]
;;

let build
      ~ocaml_config
      ~dependencies
      ~c_files
      ~asm_files
      ~build_flags
      ~link_flags
      { target = name, main; external_libraries; _ }
  =
  let c_compiler = String.Map.find "c_compiler" ocaml_config in
  let ext_obj =
    try String.Map.find "ext_obj" ocaml_config with
    | Not_found -> ".o"
  in
  let num_dependencies = List.length dependencies in
  let table = Hashtbl.create num_dependencies in
  Status_line.num_jobs := num_dependencies;
  let build m =
    match Hashtbl.find table m with
    | Not_started f ->
      Hashtbl.replace table m Initializing;
      Fiber.fork f
      >>= fun fut ->
      Hashtbl.replace table m (Started fut);
      Fiber.Future.wait fut >>| fun () -> incr Status_line.num_jobs_finished
    | Initializing -> fatal "dependency cycle!"
    | Started fut -> Fiber.Future.wait fut
    | exception Not_found -> fatal "file not found: %s" m
  in
  let external_libraries, external_includes = resolve_externals external_libraries in
  List.iter dependencies ~f:(fun (file, deps) ->
    Hashtbl.add
      table
      file
      (Not_started
         (fun () ->
           Fiber.parallel_iter deps ~f:build
           >>= fun () ->
           Process.run
             ~cwd:build_dir
             Config.compiler
             (List.concat
                [ [ "-c"; "-g"; "-no-alias-deps" ]
                ; ocaml_warnings
                ; allow_unstable_sources
                ; external_includes
                ; [ file ]
                ]))));
  Fiber.fork_and_join_unit
    (fun () -> build (Filename.basename main))
    (fun () ->
       (Fiber.fork_and_join (fun () ->
          Fiber.parallel_map c_files ~f:(fun { Library.name = file; flags } ->
            let flags =
              List.map flags ~f:(fun flag -> [ "-ccopt"; flag ]) |> List.concat
            in
            Process.run
              ~cwd:build_dir
              Config.compiler
              (List.concat
                 [ [ "-c"; "-g" ]; external_includes; build_flags; [ file ]; flags ])
            >>| fun () -> Filename.chop_extension file ^ ext_obj)))
         (fun () ->
            Fiber.parallel_map asm_files ~f:(fun { Library.assembler; flags; out_file } ->
              Process.run
                ~cwd:build_dir
                (match assembler with
                 | `C_comp -> c_compiler
                 | `Msvc_asm -> "ml64.exe")
                flags
              >>| fun () -> out_file))
       >>| fun (x, y) -> x @ y)
  >>= fun obj_files ->
  let compiled_ml_files =
    let compiled_ml_ext =
      match Config.mode with
      | Byte -> ".cmo"
      | Native -> ".cmx"
    in
    List.filter_map (sort_files dependencies ~main) ~f:(fun fn ->
      match Filename.extension fn with
      | ".ml" -> Some (Filename.remove_extension fn ^ compiled_ml_ext)
      | _ -> None)
  in
  write_args "compiled_ml_files" compiled_ml_files;
  Process.run
    ~cwd:build_dir
    Config.compiler
    (let static_flags = if static then [ "-ccopt"; "-static" ] else [] in
     List.concat
       [ common_build_args name ~external_includes ~external_libraries
       ; obj_files
       ; [ "-args"; "compiled_ml_files" ]
       ; link_flags
       ; static_flags
       ; allow_unstable_sources
       ])
;;

let rec rm_rf fn =
  match Unix.lstat fn with
  | { st_kind = S_DIR; _ } ->
    clear fn;
    Unix.rmdir fn
  | _ -> Unix.unlink fn
  | exception Unix.Unix_error (ENOENT, _, _) -> ()

and clear dir = List.iter (readdir dir) ~f:rm_rf

let rec get_flags system = function
  | (set, f) :: r -> if List.mem system ~set then f else get_flags system r
  | [] -> []
;;

(** {2 Bootstrap process} *)
let main () =
  (try clear build_dir with
   | Sys_error _ -> ());
  (try Unix.mkdir build_dir 0o777 with
   | Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  Config.ocaml_config ()
  >>= fun ocaml_config ->
  let word_size = String.Map.find "word_size" ocaml_config in
  let os_type = String.Map.find "os_type" ocaml_config in
  assemble_libraries ~ocaml_config ~word_size ~os_type task
  >>= fun libraries ->
  let c_files =
    List.map ~f:(fun (lib : Library.t) -> lib.c_files) libraries |> List.concat
  in
  let asm_files =
    List.map ~f:(fun (lib : Library.t) -> lib.asm_files) libraries |> List.concat
  in
  get_dependencies libraries
  >>= fun dependencies ->
  let ocaml_system =
    match String.Map.find_opt "system" ocaml_config with
    | None -> assert false
    | Some s -> s
  in
  let build_flags = get_flags ocaml_system Libs.build_flags in
  let link_flags = get_flags ocaml_system Libs.link_flags in
  build ~ocaml_config ~dependencies ~asm_files ~c_files ~build_flags ~link_flags task
;;

let () = Fiber.run (main ())