<commit_before>open! Stdune
open Import
open Fiber.O

module Kind = struct
  module Opam = struct
    type t =
      { root : string option
      ; switch : string
      }
  end

  type t =
    | Default
    | Opam of Opam.t

  let to_dyn : t -> Dyn.t = function
    | Default -> Dyn.Encoder.string "default"
    | Opam o ->
      Dyn.Encoder.(
        record [ ("root", option string o.root); ("switch", string o.switch) ])
end

module Env_nodes = struct
  type t =
    { context : Dune_env.Stanza.t
    ; workspace : Dune_env.Stanza.t
    }

  let extra_env ~profile env_nodes =
    Env.extend_env (Dune_env.Stanza.find env_nodes.context ~profile).env_vars
      (Dune_env.Stanza.find env_nodes.workspace ~profile).env_vars
end

module Program = struct
  module Name = String

  module Which_path = struct
    type t = Path.t option

    let equal = Option.equal Path.equal

    let to_dyn = Dyn.Encoder.option Path.to_dyn
  end

  let programs_for_which_we_prefer_opt_ext =
    [ "ocamlc"; "ocamldep"; "ocamlmklib"; "ocamlobjinfo"; "ocamlopt" ]

  let best_path dir program =
    let exe_path program =
      let fn = Path.relative dir (program ^ Bin.exe) in
      Option.some_if (Bin.exists fn) fn
    in
    if List.mem program ~set:programs_for_which_we_prefer_opt_ext then
      match exe_path (program ^ ".opt") with
      | None -> exe_path program
      | Some _ as path -> path
    else
      exe_path program

  let which ~path program =
    List.find_map path ~f:(fun dir -> best_path dir program)
end

module T = struct
  type t =
    { name : Context_name.t
    ; kind : Kind.t
    ; profile : Profile.t
    ; merlin : bool
    ; fdo_target_exe : Path.t option
    ; dynamically_linked_foreign_archives : bool
    ; for_host : t option
    ; implicit : bool
    ; build_dir : Path.Build.t
    ; env_nodes : Env_nodes.t
    ; path : Path.t list
    ; toplevel_path : Path.t option
    ; ocaml_bin : Path.t
    ; ocaml : Action.Prog.t
    ; ocamlc : Path.t
    ; ocamlopt : Action.Prog.t
    ; ocamldep : Action.Prog.t
    ; ocamlmklib : Action.Prog.t
    ; ocamlobjinfo : Action.Prog.t
    ; env : Env.t
    ; findlib : Findlib.t
    ; findlib_toolchain : Context_name.t option
    ; arch_sixtyfour : bool
    ; install_prefix : Path.t Memo.Lazy.Async.t
    ; ocaml_config : Ocaml_config.t
    ; version : Ocaml_version.t
    ; stdlib_dir : Path.t
    ; supports_shared_libraries : Dynlink_supported.By_the_os.t
    ; which : string -> Path.t option
    ; lib_config : Lib_config.t
    }

  let equal x y = Context_name.equal x.name y.name

  let hash t = Context_name.hash t.name

  let to_dyn t : Dyn.t =
    let open Dyn.Encoder in
    let path = Path.to_dyn in
    record
      [ ("name", Context_name.to_dyn t.name)
      ; ("kind", Kind.to_dyn t.kind)
      ; ("profile", Profile.to_dyn t.profile)
      ; ("merlin", Bool t.merlin)
      ; ( "for_host"
        , option Context_name.to_dyn
            (Option.map t.for_host ~f:(fun t -> t.name)) )
      ; ("fdo_target_exe", option path t.fdo_target_exe)
      ; ("build_dir", Path.Build.to_dyn t.build_dir)
      ; ("toplevel_path", option path t.toplevel_path)
      ; ("ocaml_bin", path t.ocaml_bin)
      ; ("ocaml", Action.Prog.to_dyn t.ocaml)
      ; ("ocamlc", path t.ocamlc)
      ; ("ocamlopt", Action.Prog.to_dyn t.ocamlopt)
      ; ("ocamldep", Action.Prog.to_dyn t.ocamldep)
      ; ("ocamlmklib", Action.Prog.to_dyn t.ocamlmklib)
      ; ("env", Env.to_dyn (Env.diff t.env Env.initial))
      ; ("findlib_path", list path (Findlib.paths t.findlib))
      ; ("arch_sixtyfour", Bool t.arch_sixtyfour)
      ; ( "natdynlink_supported"
        , Bool
            (Dynlink_supported.By_the_os.get t.lib_config.natdynlink_supported)
        )
      ; ( "supports_shared_libraries"
        , Bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries) )
      ; ("ocaml_config", Ocaml_config.to_dyn t.ocaml_config)
      ]
end

include T

let to_dyn_concise t : Dyn.t = Context_name.to_dyn t.name

let compare a b = Poly.compare a.name b.name

let opam = Memo.lazy_ (fun () -> Bin.which ~path:(Env.path Env.initial) "opam")

let read_opam_config_var ~env (var : string) : string option Fiber.t =
  let (_ : Memo.Run.t) = Memo.current_run () in
  match Memo.Lazy.force opam with
  | None -> Fiber.return None
  | Some fn -> (
    Process.run_capture (Accept Predicate_lang.any) fn ~env
      [ "config"; "var"; var ]
    >>| function
    | Ok s -> Some (String.trim s)
    | Error _ -> None )

let ocamlpath_sep =
  if Sys.cygwin then
    (* because that's what ocamlfind expects *)
    ';'
  else
    Bin.path_sep

module Build_environment_kind = struct
  (* Heuristics to detect the current environment *)

  type t =
    | Cross_compilation_using_findlib_toolchain of Context_name.t
    | Hardcoded_path of string list
    | Opam2_environment of string (* opam switch prefix *)
    | Opam1_environment
    | Unknown

  let query ~(kind : Kind.t) ~findlib_toolchain ~env =
    let opam_prefix = Env.get env "OPAM_SWITCH_PREFIX" in
    match findlib_toolchain with
    | Some s -> Cross_compilation_using_findlib_toolchain s
    | None -> (
      match kind with
      | Opam _ -> (
        match opam_prefix with
        | Some s -> Opam2_environment s
        | None -> Opam1_environment )
      | Default -> (
        match Setup.library_path with
        | Some l -> Hardcoded_path l
        | None -> (
          match opam_prefix with
          | Some s -> Opam2_environment s
          | None -> Unknown ) ) )
end

let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain =
  let args =
    let args = [ "printconf"; "path" ] in
    match toolchain with
    | None -> args
    | Some s -> "-toolchain" :: Context_name.to_string s :: args
  in
  let+ l = Process.run_capture_lines ~env Strict ocamlfind args in
  List.map l ~f:Path.of_filename_relative_to_initial_cwd

let check_fdo_support has_native ocfg ~name =
  let version = Ocaml_version.of_ocaml_config ocfg in
  let version_string = Ocaml_config.version_string ocfg in
  let err () =
    User_error.raise
      [ Pp.textf
          "fdo requires ocamlopt version >= 4.10, current version is %s \
           (context: %s)"
          (Context_name.to_string name)
          version_string
      ]
  in
  if not has_native then err ();
  if Ocaml_config.is_dev_version ocfg then
    ( (* Allows fdo to be invoked with any dev version of the compiler. This is
         experimental and will be removed when ocamlfdo is fully integrated into
         the toolchain. When using a dev version of ocamlopt that does not
         support the required options, fdo builds will fail because the compiler
         won't recongnize the options. Normals builds won't be affected. *) )
  else if not (Ocaml_version.supports_split_at_emit version) then
    if not (Ocaml_version.supports_function_sections version) then
      err ()
    else
      User_warning.emit
        [ Pp.textf
            "fdo requires ocamlopt version >= 4.10, current version %s has \
             partial support. Some optimizations are disabled! (context: %s)"
            (Context_name.to_string name)
            version_string
        ]

(* We store this so that library such as dune-configurator can read things
   runtime. Ideally, this should be created on-demand if we run a program linked
   against configurator, however we currently don't support this kind of
   "runtime dependencies" so we just do it eagerly. *)
let write_dot_dune_dir ~build_dir ~ocamlc ~ocaml_config_vars =
  let dir = Path.build (Path.Build.relative build_dir ".dune") in
  Path.rm_rf dir;
  Path.mkdir_p dir;
  Io.write_file (Path.relative dir Config.dune_keep_fname) "";
  let csexp =
    let open Sexp in
    let ocamlc = Atom (Path.to_absolute_filename ocamlc) in
    let ocaml_config_vars =
      Sexp.List
        ( Ocaml_config.Vars.to_list ocaml_config_vars
        |> List.map ~f:(fun (k, v) -> List [ Atom k; Atom v ]) )
    in
    List
      [ List [ Atom "ocamlc"; ocamlc ]
      ; List [ Atom "ocaml_config_vars"; ocaml_config_vars ]
      ]
  in
  let path = Path.relative dir "configurator.v2" in
  Io.write_file path (Csexp.to_string csexp)

let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
    ~host_context ~host_toolchain ~profile ~fdo_target_exe
    ~dynamically_linked_foreign_archives ~bisect_enabled =
  let prog_not_found_in_path prog =
    Utils.program_not_found prog ~context:name ~loc:None
  in
  let which_memo =<commit_msg>Generate ./dune/configurator in the old format<commit_after>open! Stdune
open Import
open Fiber.O

module Kind = struct
  module Opam = struct
    type t =
      { root : string option
      ; switch : string
      }
  end

  type t =
    | Default
    | Opam of Opam.t

  let to_dyn : t -> Dyn.t = function
    | Default -> Dyn.Encoder.string "default"
    | Opam o ->
      Dyn.Encoder.(
        record [ ("root", option string o.root); ("switch", string o.switch) ])
end

module Env_nodes = struct
  type t =
    { context : Dune_env.Stanza.t
    ; workspace : Dune_env.Stanza.t
    }

  let extra_env ~profile env_nodes =
    Env.extend_env (Dune_env.Stanza.find env_nodes.context ~profile).env_vars
      (Dune_env.Stanza.find env_nodes.workspace ~profile).env_vars
end

module Program = struct
  module Name = String

  module Which_path = struct
    type t = Path.t option

    let equal = Option.equal Path.equal

    let to_dyn = Dyn.Encoder.option Path.to_dyn
  end

  let programs_for_which_we_prefer_opt_ext =
    [ "ocamlc"; "ocamldep"; "ocamlmklib"; "ocamlobjinfo"; "ocamlopt" ]

  let best_path dir program =
    let exe_path program =
      let fn = Path.relative dir (program ^ Bin.exe) in
      Option.some_if (Bin.exists fn) fn
    in
    if List.mem program ~set:programs_for_which_we_prefer_opt_ext then
      match exe_path (program ^ ".opt") with
      | None -> exe_path program
      | Some _ as path -> path
    else
      exe_path program

  let which ~path program =
    List.find_map path ~f:(fun dir -> best_path dir program)
end

module T = struct
  type t =
    { name : Context_name.t
    ; kind : Kind.t
    ; profile : Profile.t
    ; merlin : bool
    ; fdo_target_exe : Path.t option
    ; dynamically_linked_foreign_archives : bool
    ; for_host : t option
    ; implicit : bool
    ; build_dir : Path.Build.t
    ; env_nodes : Env_nodes.t
    ; path : Path.t list
    ; toplevel_path : Path.t option
    ; ocaml_bin : Path.t
    ; ocaml : Action.Prog.t
    ; ocamlc : Path.t
    ; ocamlopt : Action.Prog.t
    ; ocamldep : Action.Prog.t
    ; ocamlmklib : Action.Prog.t
    ; ocamlobjinfo : Action.Prog.t
    ; env : Env.t
    ; findlib : Findlib.t
    ; findlib_toolchain : Context_name.t option
    ; arch_sixtyfour : bool
    ; install_prefix : Path.t Memo.Lazy.Async.t
    ; ocaml_config : Ocaml_config.t
    ; version : Ocaml_version.t
    ; stdlib_dir : Path.t
    ; supports_shared_libraries : Dynlink_supported.By_the_os.t
    ; which : string -> Path.t option
    ; lib_config : Lib_config.t
    }

  let equal x y = Context_name.equal x.name y.name

  let hash t = Context_name.hash t.name

  let to_dyn t : Dyn.t =
    let open Dyn.Encoder in
    let path = Path.to_dyn in
    record
      [ ("name", Context_name.to_dyn t.name)
      ; ("kind", Kind.to_dyn t.kind)
      ; ("profile", Profile.to_dyn t.profile)
      ; ("merlin", Bool t.merlin)
      ; ( "for_host"
        , option Context_name.to_dyn
            (Option.map t.for_host ~f:(fun t -> t.name)) )
      ; ("fdo_target_exe", option path t.fdo_target_exe)
      ; ("build_dir", Path.Build.to_dyn t.build_dir)
      ; ("toplevel_path", option path t.toplevel_path)
      ; ("ocaml_bin", path t.ocaml_bin)
      ; ("ocaml", Action.Prog.to_dyn t.ocaml)
      ; ("ocamlc", path t.ocamlc)
      ; ("ocamlopt", Action.Prog.to_dyn t.ocamlopt)
      ; ("ocamldep", Action.Prog.to_dyn t.ocamldep)
      ; ("ocamlmklib", Action.Prog.to_dyn t.ocamlmklib)
      ; ("env", Env.to_dyn (Env.diff t.env Env.initial))
      ; ("findlib_path", list path (Findlib.paths t.findlib))
      ; ("arch_sixtyfour", Bool t.arch_sixtyfour)
      ; ( "natdynlink_supported"
        , Bool
            (Dynlink_supported.By_the_os.get t.lib_config.natdynlink_supported)
        )
      ; ( "supports_shared_libraries"
        , Bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries) )
      ; ("ocaml_config", Ocaml_config.to_dyn t.ocaml_config)
      ]
end

include T

let to_dyn_concise t : Dyn.t = Context_name.to_dyn t.name

let compare a b = Poly.compare a.name b.name

let opam = Memo.lazy_ (fun () -> Bin.which ~path:(Env.path Env.initial) "opam")

let read_opam_config_var ~env (var : string) : string option Fiber.t =
  let (_ : Memo.Run.t) = Memo.current_run () in
  match Memo.Lazy.force opam with
  | None -> Fiber.return None
  | Some fn -> (
    Process.run_capture (Accept Predicate_lang.any) fn ~env
      [ "config"; "var"; var ]
    >>| function
    | Ok s -> Some (String.trim s)
    | Error _ -> None )

let ocamlpath_sep =
  if Sys.cygwin then
    (* because that's what ocamlfind expects *)
    ';'
  else
    Bin.path_sep

module Build_environment_kind = struct
  (* Heuristics to detect the current environment *)

  type t =
    | Cross_compilation_using_findlib_toolchain of Context_name.t
    | Hardcoded_path of string list
    | Opam2_environment of string (* opam switch prefix *)
    | Opam1_environment
    | Unknown

  let query ~(kind : Kind.t) ~findlib_toolchain ~env =
    let opam_prefix = Env.get env "OPAM_SWITCH_PREFIX" in
    match findlib_toolchain with
    | Some s -> Cross_compilation_using_findlib_toolchain s
    | None -> (
      match kind with
      | Opam _ -> (
        match opam_prefix with
        | Some s -> Opam2_environment s
        | None -> Opam1_environment )
      | Default -> (
        match Setup.library_path with
        | Some l -> Hardcoded_path l
        | None -> (
          match opam_prefix with
          | Some s -> Opam2_environment s
          | None -> Unknown ) ) )
end

let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain =
  let args =
    let args = [ "printconf"; "path" ] in
    match toolchain with
    | None -> args
    | Some s -> "-toolchain" :: Context_name.to_string s :: args
  in
  let+ l = Process.run_capture_lines ~env Strict ocamlfind args in
  List.map l ~f:Path.of_filename_relative_to_initial_cwd

let check_fdo_support has_native ocfg ~name =
  let version = Ocaml_version.of_ocaml_config ocfg in
  let version_string = Ocaml_config.version_string ocfg in
  let err () =
    User_error.raise
      [ Pp.textf
          "fdo requires ocamlopt version >= 4.10, current version is %s \
           (context: %s)"
          (Context_name.to_string name)
          version_string
      ]
  in
  if not has_native then err ();
  if Ocaml_config.is_dev_version ocfg then
    ( (* Allows fdo to be invoked with any dev version of the compiler. This is
         experimental and will be removed when ocamlfdo is fully integrated into
         the toolchain. When using a dev version of ocamlopt that does not
         support the required options, fdo builds will fail because the compiler
         won't recongnize the options. Normals builds won't be affected. *) )
  else if not (Ocaml_version.supports_split_at_emit version) then
    if not (Ocaml_version.supports_function_sections version) then
      err ()
    else
      User_warning.emit
        [ Pp.textf
            "fdo requires ocamlopt version >= 4.10, current version %s has \
             partial support. Some optimizations are disabled! (context: %s)"
            (Context_name.to_string name)
            version_string
        ]

(* We store this so that library such as dune-configurator can read things
   runtime. Ideally, this should be created on-demand if we run a program linked
   against configurator, however we currently don't support this kind of
   "runtime dependencies" so we just do it eagerly. *)
let write_dot_dune_dir ~build_dir ~ocamlc ~ocaml_config_vars =
  let dir = Path.build (Path.Build.relative build_dir ".dune") in
  Path.rm_rf dir;
  Path.mkdir_p dir;
  Io.write_file (Path.relative dir Config.dune_keep_fname) "";
  let ocamlc = Path.to_absolute_filename ocamlc in
  let ocaml_config_vars = Ocaml_config.Vars.to_list ocaml_config_vars in
  let () =
    let open Dune_lang.Encoder in
    Io.write_lines
      (Path.relative dir "configurator")
      (List.map ~f:Dune_lang.to_string
         (record_fields
            [ field "ocamlc" string ocamlc
            ; field_l "ocaml_config_vars" (pair string string) ocaml_config_vars
            ]))
  in
  let () =
    let csexp =
      let open Sexp in
      let ocaml_config_vars =
        Sexp.List
          (List.map ocaml_config_vars ~f:(fun (k, v) -> List [ Atom k; Atom v ]))
      in
      List
        [ List [ Atom "ocamlc"; Atom ocamlc ]
        ; List [ Atom "ocaml_config_vars"; ocaml_config_vars ]
        ]
    in
    let path = Path.relative dir "configurator.v2" in
    Io.write_file path (Csexp.to_string csexp)
  in
  ()

let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
    ~host_context ~host_toolchain ~profile ~fdo_target_exe
    ~dynamically_linked_foreign_archives ~bisect_enabled =
  let prog_not_found_in_path prog =
    Utils.program_not_found prog ~context:name ~loc:None
  in
  let which_memo =
{'fraction_non_alphanumeric': 0.09583597304613257, 'fraction_numerical': 0.001382249611242297, 'mean_word_length': 2.6448362720403025, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 64, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1958640', 'n_tokens_mistral': 6077, 'n_tokens_neox': 5940, 'n_words': 1584}