2016-12-02 13:54:32 +00:00
|
|
|
open Import
|
2018-02-06 14:39:03 +00:00
|
|
|
open Fiber.O
|
2016-12-02 13:54:32 +00:00
|
|
|
|
|
|
|
module Kind = struct
|
2017-02-26 21:28:30 +00:00
|
|
|
module Opam = struct
|
|
|
|
type t =
|
|
|
|
{ root : string
|
|
|
|
; switch : string
|
|
|
|
}
|
|
|
|
end
|
|
|
|
type t = Default | Opam of Opam.t
|
2017-03-10 11:22:01 +00:00
|
|
|
|
|
|
|
let sexp_of_t : t -> Sexp.t = function
|
|
|
|
| Default -> Atom "default"
|
|
|
|
| Opam o ->
|
|
|
|
Sexp.To_sexp.(record [ "root" , string o.root
|
|
|
|
; "switch", string o.switch
|
|
|
|
])
|
2016-12-02 13:54:32 +00:00
|
|
|
end
|
|
|
|
|
2017-04-24 11:27:13 +00:00
|
|
|
module Env_var = struct
|
|
|
|
type t = string
|
|
|
|
let compare a b =
|
|
|
|
if Sys.win32 then
|
2017-07-06 12:32:46 +00:00
|
|
|
String.compare (String.lowercase_ascii a) (String.lowercase_ascii b)
|
2017-04-24 11:27:13 +00:00
|
|
|
else
|
|
|
|
String.compare a b
|
|
|
|
end
|
|
|
|
|
|
|
|
module Env_var_map = Map.Make(Env_var)
|
|
|
|
|
2016-12-02 13:54:32 +00:00
|
|
|
type t =
|
2017-02-25 00:28:10 +00:00
|
|
|
{ name : string
|
|
|
|
; kind : Kind.t
|
2017-02-26 20:53:32 +00:00
|
|
|
; merlin : bool
|
2016-12-02 13:54:32 +00:00
|
|
|
; for_host : t option
|
2017-12-21 11:54:00 +00:00
|
|
|
; implicit : bool
|
2016-12-02 13:54:32 +00:00
|
|
|
; build_dir : Path.t
|
|
|
|
; path : Path.t list
|
2017-02-28 06:31:02 +00:00
|
|
|
; toplevel_path : Path.t option
|
2016-12-02 13:54:32 +00:00
|
|
|
; ocaml_bin : Path.t
|
|
|
|
; ocaml : Path.t
|
|
|
|
; ocamlc : Path.t
|
|
|
|
; ocamlopt : Path.t option
|
|
|
|
; ocamldep : Path.t
|
|
|
|
; ocamlmklib : Path.t
|
|
|
|
; env : string array
|
2017-04-24 11:27:13 +00:00
|
|
|
; env_extra : string Env_var_map.t
|
2017-02-28 06:01:27 +00:00
|
|
|
; findlib : Findlib.t
|
2017-12-21 11:54:00 +00:00
|
|
|
; findlib_toolchain : string option
|
2016-12-02 13:54:32 +00:00
|
|
|
; arch_sixtyfour : bool
|
2017-02-28 06:01:27 +00:00
|
|
|
; opam_var_cache : (string, string) Hashtbl.t
|
2017-03-07 11:36:59 +00:00
|
|
|
; natdynlink_supported : bool
|
2017-02-26 19:49:54 +00:00
|
|
|
; ocamlc_config : (string * string) list
|
2018-02-08 10:12:46 +00:00
|
|
|
; version_string : string
|
|
|
|
; version : int * int * int
|
2016-12-02 13:54:32 +00:00
|
|
|
; stdlib_dir : Path.t
|
|
|
|
; ccomp_type : string
|
2017-03-31 16:31:55 +00:00
|
|
|
; c_compiler : string
|
|
|
|
; ocamlc_cflags : string
|
|
|
|
; ocamlopt_cflags : string
|
2016-12-02 13:54:32 +00:00
|
|
|
; bytecomp_c_libraries : string
|
|
|
|
; native_c_libraries : string
|
|
|
|
; native_pack_linker : string
|
|
|
|
; ranlib : string
|
|
|
|
; cc_profile : string
|
|
|
|
; architecture : string
|
|
|
|
; system : string
|
|
|
|
; ext_obj : string
|
|
|
|
; ext_asm : string
|
|
|
|
; ext_lib : string
|
|
|
|
; ext_dll : string
|
|
|
|
; os_type : string
|
|
|
|
; default_executable_name : string
|
|
|
|
; host : string
|
|
|
|
; target : string
|
|
|
|
; flambda : bool
|
|
|
|
; exec_magic_number : string
|
|
|
|
; cmi_magic_number : string
|
|
|
|
; cmo_magic_number : string
|
|
|
|
; cma_magic_number : string
|
|
|
|
; cmx_magic_number : string
|
|
|
|
; cmxa_magic_number : string
|
|
|
|
; ast_impl_magic_number : string
|
|
|
|
; ast_intf_magic_number : string
|
|
|
|
; cmxs_magic_number : string
|
|
|
|
; cmt_magic_number : string
|
2017-03-01 11:04:32 +00:00
|
|
|
; which_cache : (string, Path.t option) Hashtbl.t
|
2016-12-02 13:54:32 +00:00
|
|
|
}
|
|
|
|
|
2017-03-10 11:22:01 +00:00
|
|
|
let sexp_of_t t =
|
|
|
|
let open Sexp.To_sexp in
|
|
|
|
let path = Path.sexp_of_t in
|
|
|
|
record
|
|
|
|
[ "name", string t.name
|
|
|
|
; "kind", Kind.sexp_of_t t.kind
|
|
|
|
; "merlin", bool t.merlin
|
|
|
|
; "for_host", option string (Option.map t.for_host ~f:(fun t -> t.name))
|
|
|
|
; "build_dir", path t.build_dir
|
|
|
|
; "toplevel_path", option path t.toplevel_path
|
|
|
|
; "ocaml_bin", path t.ocaml_bin
|
|
|
|
; "ocaml", path t.ocaml
|
|
|
|
; "ocamlc", path t.ocamlc
|
|
|
|
; "ocamlopt", option path t.ocamlopt
|
|
|
|
; "ocamldep", path t.ocamldep
|
|
|
|
; "ocamlmklib", path t.ocamlmklib
|
2017-04-24 11:27:13 +00:00
|
|
|
; "env", list (pair string string) (Env_var_map.bindings t.env_extra)
|
2017-03-10 11:22:01 +00:00
|
|
|
; "findlib_path", list path (Findlib.path t.findlib)
|
|
|
|
; "arch_sixtyfour", bool t.arch_sixtyfour
|
|
|
|
; "natdynlink_supported", bool t.natdynlink_supported
|
|
|
|
; "opam_vars", string_hashtbl string t.opam_var_cache
|
|
|
|
; "ocamlc_config", list (pair string string) t.ocamlc_config
|
|
|
|
; "which", string_hashtbl (option path) t.which_cache
|
|
|
|
]
|
|
|
|
|
2017-02-25 14:15:52 +00:00
|
|
|
let compare a b = compare a.name b.name
|
|
|
|
|
2016-12-02 13:54:32 +00:00
|
|
|
let get_arch_sixtyfour stdlib_dir =
|
2017-11-02 12:31:14 +00:00
|
|
|
let files = ["caml/config.h"; "caml/m.h"] in
|
|
|
|
let get_arch_sixtyfour_from file =
|
2017-11-06 08:30:50 +00:00
|
|
|
let file_path = Path.to_string (Path.relative stdlib_dir file) in
|
|
|
|
if Sys.file_exists file_path then begin
|
|
|
|
List.exists (Io.lines_of_file file_path) ~f:(fun line ->
|
|
|
|
match String.extract_blank_separated_words line with
|
|
|
|
| ["#define"; "ARCH_SIXTYFOUR"] -> true
|
|
|
|
| _ -> false)
|
|
|
|
end else
|
|
|
|
false
|
2017-11-02 12:31:14 +00:00
|
|
|
in
|
|
|
|
List.exists ~f:get_arch_sixtyfour_from files
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-24 15:41:52 +00:00
|
|
|
let opam_config_var ~env ~cache var =
|
|
|
|
match Hashtbl.find cache var with
|
2018-02-06 14:39:03 +00:00
|
|
|
| Some _ as x -> Fiber.return x
|
2017-02-24 15:41:52 +00:00
|
|
|
| None ->
|
|
|
|
match Bin.opam with
|
2018-02-06 14:39:03 +00:00
|
|
|
| None -> Fiber.return None
|
2017-02-24 15:41:52 +00:00
|
|
|
| Some fn ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Process.run_capture (Accept All) (Path.to_string fn) ~env ["config"; "var"; var]
|
2017-07-05 13:40:00 +00:00
|
|
|
>>| function
|
|
|
|
| Ok s ->
|
|
|
|
let s = String.trim s in
|
|
|
|
Hashtbl.add cache ~key:var ~data:s;
|
|
|
|
Some s
|
|
|
|
| Error _ -> None
|
2017-02-24 15:41:52 +00:00
|
|
|
|
2017-02-28 06:31:02 +00:00
|
|
|
let get_env env var =
|
|
|
|
let rec loop i =
|
|
|
|
if i = Array.length env then
|
|
|
|
None
|
|
|
|
else
|
|
|
|
let entry = env.(i) in
|
2017-04-24 11:27:13 +00:00
|
|
|
match String.lsplit2 entry ~on:'=' with
|
|
|
|
| Some (key, value) when Env_var.compare key var = 0 ->
|
|
|
|
Some value
|
|
|
|
| _ -> loop (i + 1)
|
2017-02-28 06:31:02 +00:00
|
|
|
in
|
|
|
|
loop 0
|
|
|
|
|
2017-03-01 11:04:32 +00:00
|
|
|
let which ~cache ~path x =
|
|
|
|
Hashtbl.find_or_add cache x ~f:(Bin.which ~path)
|
|
|
|
|
2017-03-10 11:22:01 +00:00
|
|
|
let extend_env ~vars ~env =
|
2017-04-24 11:27:13 +00:00
|
|
|
if Env_var_map.is_empty vars then
|
2017-03-10 11:22:01 +00:00
|
|
|
env
|
|
|
|
else
|
|
|
|
let imported =
|
|
|
|
Array.to_list env
|
|
|
|
|> List.filter ~f:(fun s ->
|
|
|
|
match String.index s '=' with
|
|
|
|
| None -> true
|
|
|
|
| Some i ->
|
|
|
|
let key = String.sub s ~pos:0 ~len:i in
|
2017-04-24 11:27:13 +00:00
|
|
|
not (Env_var_map.mem key vars))
|
2017-03-10 11:22:01 +00:00
|
|
|
in
|
|
|
|
List.rev_append
|
2017-04-24 11:27:13 +00:00
|
|
|
(List.map (Env_var_map.bindings vars) ~f:(fun (k, v) -> sprintf "%s=%s" k v))
|
2017-03-10 11:22:01 +00:00
|
|
|
imported
|
|
|
|
|> Array.of_list
|
|
|
|
|
2017-12-21 11:54:00 +00:00
|
|
|
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
|
|
|
~use_findlib ~targets () =
|
2017-03-10 11:22:01 +00:00
|
|
|
let env = extend_env ~env:base_env ~vars:env_extra in
|
2017-02-24 15:41:52 +00:00
|
|
|
let opam_var_cache = Hashtbl.create 128 in
|
|
|
|
(match kind with
|
|
|
|
| Opam { root; _ } ->
|
|
|
|
Hashtbl.add opam_var_cache ~key:"root" ~data:root
|
|
|
|
| Default -> ());
|
2016-12-02 13:54:32 +00:00
|
|
|
let prog_not_found_in_path prog =
|
2017-03-31 16:31:55 +00:00
|
|
|
Utils.program_not_found prog ~context:name
|
2016-12-02 13:54:32 +00:00
|
|
|
in
|
2017-03-01 11:04:32 +00:00
|
|
|
let which_cache = Hashtbl.create 128 in
|
|
|
|
let which x = which ~cache:which_cache ~path x in
|
2017-12-21 11:54:00 +00:00
|
|
|
let findlib_config_path = lazy (
|
|
|
|
match which "ocamlfind" with
|
|
|
|
| None -> prog_not_found_in_path "ocamlfind"
|
|
|
|
| Some fn ->
|
|
|
|
(* When OCAMLFIND_CONF is set, "ocamlfind printconf" does print the contents of the
|
|
|
|
variable, but "ocamlfind printconf conf" still prints the configuration file set
|
|
|
|
at the configuration time of ocamlfind, sigh... *)
|
|
|
|
match Sys.getenv "OCAMLFIND_CONF" with
|
2018-02-06 14:39:03 +00:00
|
|
|
| s -> Fiber.return (Path.absolute s)
|
2017-12-21 11:54:00 +00:00
|
|
|
| exception Not_found ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Process.run_capture_line ~env Strict
|
2017-12-21 11:54:00 +00:00
|
|
|
(Path.to_string fn) ["printconf"; "conf"]
|
|
|
|
>>| Path.absolute)
|
2016-12-02 13:54:32 +00:00
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
|
|
|
|
let create_one ~name ~implicit ?findlib_toolchain ?host ~merlin () =
|
|
|
|
(match findlib_toolchain with
|
2018-02-06 14:39:03 +00:00
|
|
|
| None -> Fiber.return None
|
2017-12-21 11:54:00 +00:00
|
|
|
| Some toolchain ->
|
|
|
|
Lazy.force findlib_config_path >>| fun path ->
|
|
|
|
Some (Findlib.Config.load path ~toolchain ~context:name))
|
|
|
|
>>= fun findlib_config ->
|
|
|
|
|
|
|
|
let get_tool_using_findlib_config prog =
|
|
|
|
match findlib_config with
|
|
|
|
| None -> None
|
|
|
|
| Some conf ->
|
|
|
|
match Findlib.Config.get conf prog with
|
|
|
|
| "" -> None
|
|
|
|
| s ->
|
|
|
|
match Filename.analyze_program_name s with
|
|
|
|
| In_path | Relative_to_current_dir -> which s
|
|
|
|
| Absolute -> Some (Path.absolute s)
|
|
|
|
in
|
|
|
|
|
|
|
|
let ocamlc =
|
|
|
|
match get_tool_using_findlib_config "ocamlc" with
|
|
|
|
| Some x -> x
|
2017-07-25 16:07:24 +00:00
|
|
|
| None ->
|
2017-12-21 11:54:00 +00:00
|
|
|
match which "ocamlc" with
|
|
|
|
| Some x -> x
|
|
|
|
| None -> prog_not_found_in_path "ocamlc"
|
|
|
|
in
|
|
|
|
let dir = Path.parent ocamlc in
|
|
|
|
let ocaml_tool_not_found prog =
|
|
|
|
die "ocamlc found in %s, but %s/%s doesn't exist (context: %s)"
|
|
|
|
(Path.to_string dir) (Path.to_string dir) prog name
|
|
|
|
in
|
|
|
|
let get_ocaml_tool prog =
|
|
|
|
match get_tool_using_findlib_config prog with
|
|
|
|
| None -> Bin.best_prog dir prog
|
|
|
|
| Some _ as x -> x
|
|
|
|
in
|
|
|
|
let get_ocaml_tool_exn prog =
|
|
|
|
match get_ocaml_tool prog with
|
|
|
|
| None -> ocaml_tool_not_found prog
|
|
|
|
| Some fn -> fn
|
|
|
|
in
|
|
|
|
|
|
|
|
let build_dir = Path.of_string (sprintf "_build/%s" name) in
|
|
|
|
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
|
2018-02-06 14:39:03 +00:00
|
|
|
let findlib_path () =
|
2017-12-21 11:54:00 +00:00
|
|
|
if use_findlib then
|
|
|
|
(* If ocamlfind is present, it has precedence over everything else. *)
|
|
|
|
match which "ocamlfind" with
|
|
|
|
| Some fn ->
|
|
|
|
let args =
|
|
|
|
let args = ["printconf"; "path"] in
|
|
|
|
match findlib_toolchain with
|
|
|
|
| None -> args
|
|
|
|
| Some s -> "-toolchain" :: s :: args
|
|
|
|
in
|
2018-02-06 14:39:03 +00:00
|
|
|
Process.run_capture_lines ~env Strict (Path.to_string fn) args
|
2017-12-21 11:54:00 +00:00
|
|
|
>>| List.map ~f:Path.absolute
|
2017-07-25 16:07:24 +00:00
|
|
|
| None ->
|
2017-12-21 11:54:00 +00:00
|
|
|
(* If there no ocamlfind in the PATH, check if we have opam
|
|
|
|
and assume a standard opam setup *)
|
|
|
|
opam_config_var ~env ~cache:opam_var_cache "lib"
|
|
|
|
>>| function
|
|
|
|
| Some s -> [Path.absolute s]
|
|
|
|
| None ->
|
|
|
|
(* If neither opam neither ocamlfind are present, assume that libraries are
|
|
|
|
[dir ^ "/../lib"] *)
|
|
|
|
[Path.relative (Path.parent dir) "lib"]
|
|
|
|
else
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.return []
|
2017-12-21 11:54:00 +00:00
|
|
|
in
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.fork_and_join
|
2017-12-21 11:54:00 +00:00
|
|
|
findlib_path
|
2018-02-06 14:39:03 +00:00
|
|
|
(fun () ->
|
|
|
|
Process.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"])
|
2017-12-21 11:54:00 +00:00
|
|
|
>>= fun (findlib_path, ocamlc_config) ->
|
|
|
|
|
|
|
|
let ocamlc_config =
|
|
|
|
List.map ocamlc_config ~f:(fun line ->
|
|
|
|
match String.index line ':' with
|
|
|
|
| Some i ->
|
|
|
|
(String.sub line ~pos:0 ~len:i,
|
|
|
|
String.sub line ~pos:(i + 2) ~len:(String.length line - i - 2))
|
|
|
|
| None ->
|
|
|
|
die "unrecognized line in the output of `%s`: %s" ocamlc_config_cmd
|
|
|
|
line)
|
|
|
|
|> String_map.of_alist
|
|
|
|
|> function
|
|
|
|
| Ok x -> x
|
|
|
|
| Error (key, _, _) ->
|
|
|
|
die "variable %S present twice in the output of `%s`" key ocamlc_config_cmd
|
|
|
|
in
|
|
|
|
let get_opt var = String_map.find var ocamlc_config in
|
|
|
|
let get ?default var =
|
|
|
|
match get_opt var with
|
|
|
|
| Some s -> s
|
2016-12-02 13:54:32 +00:00
|
|
|
| None ->
|
2017-12-21 11:54:00 +00:00
|
|
|
match default with
|
|
|
|
| Some x -> x
|
|
|
|
| None ->
|
|
|
|
die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
|
|
|
|
in
|
|
|
|
let get_bool ?default var =
|
|
|
|
match get ?default:(Option.map default ~f:string_of_bool) var with
|
|
|
|
| "true" -> true
|
|
|
|
| "false" -> false
|
|
|
|
| _ -> die "variable %S is neither 'true' neither 'false' in the output of `%s`"
|
|
|
|
var ocamlc_config_cmd
|
|
|
|
in
|
|
|
|
let get_path var = Path.absolute (get var) in
|
|
|
|
let stdlib_dir = get_path "standard_library" in
|
|
|
|
let natdynlink_supported = Path.exists (Path.relative stdlib_dir "dynlink.cmxa") in
|
2018-02-08 10:12:46 +00:00
|
|
|
let version_string = get "version" in
|
|
|
|
let version = Scanf.sscanf version_string "%u.%u.%u" (fun a b c -> a, b, c) in
|
2017-12-21 11:54:00 +00:00
|
|
|
let env, env_extra =
|
|
|
|
(* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05,
|
|
|
|
OCAML_COLOR is not supported so we use OCAMLPARAM. OCaml 4.02 doesn't support
|
|
|
|
'color' in OCAMLPARAM, so we just don't force colors with 4.02. *)
|
|
|
|
if !Clflags.capture_outputs
|
|
|
|
&& Lazy.force Ansi_color.stderr_supports_colors
|
2018-02-08 10:12:46 +00:00
|
|
|
&& version >= (4, 03, 0)
|
|
|
|
&& version < (4, 05, 0) then
|
2017-12-21 11:54:00 +00:00
|
|
|
let value =
|
|
|
|
match get_env env "OCAMLPARAM" with
|
|
|
|
| None -> "color=always,_"
|
|
|
|
| Some s -> "color=always," ^ s
|
|
|
|
in
|
|
|
|
extend_env ~env ~vars:((Env_var_map.singleton "OCAMLPARAM" value)),
|
|
|
|
(Env_var_map.add ~key:"OCAMLPARAM" ~data:value env_extra)
|
|
|
|
else
|
|
|
|
env,env_extra
|
|
|
|
in
|
2018-01-10 16:54:25 +00:00
|
|
|
let split_prog s =
|
|
|
|
let len = String.length s in
|
|
|
|
let rec loop i =
|
|
|
|
if i = len then
|
|
|
|
(s, "")
|
|
|
|
else
|
|
|
|
match s.[i] with
|
|
|
|
| ' ' | '\t' ->
|
|
|
|
(String.sub s ~pos:0 ~len:i,
|
|
|
|
String.sub s ~pos:i ~len:(len - i))
|
|
|
|
| _ -> loop (i + 1)
|
|
|
|
in
|
|
|
|
loop 0
|
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
let c_compiler, ocamlc_cflags, ocamlopt_cflags =
|
|
|
|
match get_opt "c_compiler" with
|
|
|
|
| Some c_compiler -> (* >= 4.06 *)
|
2018-01-10 16:54:25 +00:00
|
|
|
let c_compiler, extra_args = split_prog c_compiler in
|
|
|
|
let args var =
|
|
|
|
if String.length extra_args > 0 then
|
|
|
|
sprintf "%s %s" extra_args (get var)
|
|
|
|
else
|
|
|
|
get var in
|
|
|
|
(c_compiler, args "ocamlc_cflags", args "ocamlopt_cflags")
|
2017-02-26 21:28:30 +00:00
|
|
|
| None ->
|
2017-12-21 11:54:00 +00:00
|
|
|
let c_compiler, ocamlc_cflags = split_prog (get "bytecomp_c_compiler") in
|
|
|
|
let _, ocamlopt_cflags = split_prog (get "native_c_compiler") in
|
|
|
|
(c_compiler, ocamlc_cflags, ocamlopt_cflags)
|
|
|
|
in
|
|
|
|
let arch_sixtyfour =
|
|
|
|
match get_opt "word_size" with
|
|
|
|
| Some ws -> ws = "64"
|
|
|
|
| None -> get_arch_sixtyfour stdlib_dir
|
|
|
|
in
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.return
|
2017-12-21 11:54:00 +00:00
|
|
|
{ name
|
|
|
|
; implicit
|
|
|
|
; kind
|
|
|
|
; merlin
|
|
|
|
; for_host = host
|
|
|
|
; build_dir
|
|
|
|
; path
|
|
|
|
; toplevel_path = Option.map (get_env env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
|
|
|
|
|
|
|
|
; ocaml_bin = dir
|
|
|
|
; ocaml = (match which "ocaml" with Some p -> p | None -> prog_not_found_in_path "ocaml")
|
|
|
|
; ocamlc
|
|
|
|
; ocamlopt = get_ocaml_tool "ocamlopt"
|
|
|
|
; ocamldep = get_ocaml_tool_exn "ocamldep"
|
|
|
|
; ocamlmklib = get_ocaml_tool_exn "ocamlmklib"
|
|
|
|
|
|
|
|
; env
|
|
|
|
; env_extra
|
|
|
|
; findlib = Findlib.create ~stdlib_dir ~path:findlib_path
|
|
|
|
; findlib_toolchain
|
|
|
|
; arch_sixtyfour
|
|
|
|
|
|
|
|
; opam_var_cache
|
|
|
|
|
|
|
|
; natdynlink_supported
|
|
|
|
|
|
|
|
; stdlib_dir
|
|
|
|
; ocamlc_config = String_map.bindings ocamlc_config
|
2018-02-08 10:12:46 +00:00
|
|
|
; version_string
|
2017-12-21 11:54:00 +00:00
|
|
|
; version
|
|
|
|
; ccomp_type = get "ccomp_type"
|
|
|
|
; c_compiler
|
|
|
|
; ocamlc_cflags
|
|
|
|
; ocamlopt_cflags
|
|
|
|
; bytecomp_c_libraries = get "bytecomp_c_libraries"
|
|
|
|
; native_c_libraries = get "native_c_libraries"
|
|
|
|
; native_pack_linker = get "native_pack_linker"
|
|
|
|
; ranlib = get "ranlib"
|
|
|
|
; cc_profile = get "cc_profile"
|
|
|
|
; architecture = get "architecture"
|
|
|
|
; system = get "system"
|
|
|
|
; ext_obj = get "ext_obj"
|
|
|
|
; ext_asm = get "ext_asm"
|
|
|
|
; ext_lib = get "ext_lib"
|
|
|
|
; ext_dll = get "ext_dll"
|
|
|
|
; os_type = get "os_type"
|
|
|
|
; default_executable_name = get "default_executable_name"
|
|
|
|
; host = get "host"
|
|
|
|
; target = get "target"
|
|
|
|
; flambda = get_bool "flambda" ~default:false
|
|
|
|
; exec_magic_number = get "exec_magic_number"
|
|
|
|
; cmi_magic_number = get "cmi_magic_number"
|
|
|
|
; cmo_magic_number = get "cmo_magic_number"
|
|
|
|
; cma_magic_number = get "cma_magic_number"
|
|
|
|
; cmx_magic_number = get "cmx_magic_number"
|
|
|
|
; cmxa_magic_number = get "cmxa_magic_number"
|
|
|
|
; ast_impl_magic_number = get "ast_impl_magic_number"
|
|
|
|
; ast_intf_magic_number = get "ast_intf_magic_number"
|
|
|
|
; cmxs_magic_number = get "cmxs_magic_number"
|
|
|
|
; cmt_magic_number = get "cmt_magic_number"
|
|
|
|
|
|
|
|
; which_cache
|
|
|
|
}
|
2017-11-03 13:44:41 +00:00
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
|
|
|
|
let implicit = not (List.mem ~set:targets Workspace.Context.Target.Native) in
|
|
|
|
create_one () ~implicit ~name ~merlin >>= fun native ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.parallel_map targets ~f:(function
|
|
|
|
| Native -> Fiber.return None
|
|
|
|
| Named findlib_toolchain ->
|
|
|
|
let name = sprintf "%s.%s" name findlib_toolchain in
|
|
|
|
create_one () ~implicit:false ~name ~findlib_toolchain ~host:native
|
|
|
|
~merlin:false
|
|
|
|
>>| fun x -> Some x)
|
|
|
|
>>| fun others ->
|
|
|
|
native :: List.filter_map others ~f:(fun x -> x)
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-24 15:41:52 +00:00
|
|
|
let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var
|
|
|
|
|
2017-02-23 12:12:02 +00:00
|
|
|
let initial_env = lazy (
|
2017-05-10 15:31:44 +00:00
|
|
|
Lazy.force Ansi_color.setup_env_for_colors;
|
2017-02-23 12:12:02 +00:00
|
|
|
Unix.environment ())
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-12-21 11:54:00 +00:00
|
|
|
let default ?(merlin=true) ?(use_findlib=true) ~targets () =
|
2016-12-02 13:54:32 +00:00
|
|
|
let env = Lazy.force initial_env in
|
2017-04-24 11:27:13 +00:00
|
|
|
let path =
|
|
|
|
match get_env env "PATH" with
|
|
|
|
| Some s -> Bin.parse_path s
|
|
|
|
| None -> []
|
2016-12-02 13:54:32 +00:00
|
|
|
in
|
2017-04-24 11:27:13 +00:00
|
|
|
create ~kind:Default ~path ~base_env:env ~env_extra:Env_var_map.empty
|
2017-12-21 11:54:00 +00:00
|
|
|
~name:"default" ~merlin ~use_findlib ~targets ()
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-12-21 11:54:00 +00:00
|
|
|
let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
|
2016-12-02 13:54:32 +00:00
|
|
|
match Bin.opam with
|
2017-03-31 16:31:55 +00:00
|
|
|
| None -> Utils.program_not_found "opam"
|
2016-12-02 13:54:32 +00:00
|
|
|
| Some fn ->
|
|
|
|
(match root with
|
2018-02-06 14:39:03 +00:00
|
|
|
| Some root -> Fiber.return root
|
2016-12-02 13:54:32 +00:00
|
|
|
| None ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Process.run_capture_line Strict (Path.to_string fn) ["config"; "var"; "root"])
|
2016-12-02 13:54:32 +00:00
|
|
|
>>= fun root ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Process.run_capture Strict (Path.to_string fn)
|
2016-12-02 13:54:32 +00:00
|
|
|
["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"]
|
|
|
|
>>= fun s ->
|
|
|
|
let vars =
|
2017-12-12 10:16:17 +00:00
|
|
|
Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
|
2017-03-31 16:44:03 +00:00
|
|
|
|> Sexp.Of_sexp.(list (pair string string))
|
2017-04-24 11:27:13 +00:00
|
|
|
|> Env_var_map.of_alist_multi
|
|
|
|
|> Env_var_map.mapi ~f:(fun var values ->
|
2017-03-31 16:44:03 +00:00
|
|
|
match List.rev values with
|
|
|
|
| [] -> assert false
|
|
|
|
| [x] -> x
|
|
|
|
| x :: _ ->
|
|
|
|
Format.eprintf
|
|
|
|
"@{<warning>Warning@}: variable %S present multiple times in the output of:\n\
|
|
|
|
@{<details>%s@}@."
|
|
|
|
var
|
|
|
|
(String.concat ~sep:" "
|
|
|
|
(List.map ~f:quote_for_shell
|
|
|
|
[Path.to_string fn; "config"; "env"; "--root"; root;
|
|
|
|
"--switch"; switch; "--sexp"]));
|
|
|
|
x)
|
2016-12-02 13:54:32 +00:00
|
|
|
in
|
|
|
|
let path =
|
2017-04-24 11:27:13 +00:00
|
|
|
match Env_var_map.find "PATH" vars with
|
2016-12-02 13:54:32 +00:00
|
|
|
| None -> Bin.path
|
|
|
|
| Some s -> Bin.parse_path s
|
|
|
|
in
|
|
|
|
let env = Lazy.force initial_env in
|
2017-12-21 11:54:00 +00:00
|
|
|
create ~kind:(Opam { root; switch }) ~targets
|
|
|
|
~path ~base_env:env ~env_extra:vars ~name ~merlin ~use_findlib:true ()
|
|
|
|
|
|
|
|
let create ?use_findlib ?merlin def =
|
|
|
|
match (def : Workspace.Context.t) with
|
|
|
|
| Default targets -> default ~targets ?merlin ?use_findlib ()
|
|
|
|
| Opam { name; switch; root; targets; _ } ->
|
|
|
|
create_for_opam ?root ~switch ~name ?merlin ~targets ()
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-03-01 11:04:32 +00:00
|
|
|
let which t s = which ~cache:t.which_cache ~path:t.path s
|
2017-02-24 15:41:52 +00:00
|
|
|
|
|
|
|
let install_prefix t =
|
|
|
|
opam_config_var t "prefix" >>| function
|
|
|
|
| Some x -> Path.absolute x
|
|
|
|
| None -> Path.parent t.ocaml_bin
|
2017-03-01 12:09:57 +00:00
|
|
|
|
2017-07-05 13:10:41 +00:00
|
|
|
let install_ocaml_libdir t =
|
|
|
|
(* If ocamlfind is present, it has precedence over everything else. *)
|
|
|
|
match which t "ocamlfind" with
|
|
|
|
| Some fn ->
|
2018-02-06 14:39:03 +00:00
|
|
|
(Process.run_capture_line ~env:t.env Strict
|
2017-07-05 13:10:41 +00:00
|
|
|
(Path.to_string fn) ["printconf"; "destdir"]
|
2017-07-25 16:07:24 +00:00
|
|
|
>>| fun s ->
|
|
|
|
Some (Path.absolute s))
|
2017-07-05 13:10:41 +00:00
|
|
|
| None ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.return None
|
2017-03-01 12:09:57 +00:00
|
|
|
|
|
|
|
(* CR-someday jdimino: maybe we should just do this for [t.env] directly? *)
|
|
|
|
let env_for_exec t =
|
|
|
|
let sep = if Sys.win32 then ';' else ':' in
|
|
|
|
let cwd = Sys.getcwd () in
|
|
|
|
let extend_var var v =
|
|
|
|
let v = Filename.concat cwd (Path.to_string v) in
|
|
|
|
match get_env t.env var with
|
|
|
|
| None -> (var, v)
|
|
|
|
| Some prev -> (var, sprintf "%s%c%s" v sep prev)
|
|
|
|
in
|
|
|
|
let vars =
|
2017-03-02 17:40:16 +00:00
|
|
|
[ extend_var "CAML_LD_LIBRARY_PATH" (Path.relative
|
|
|
|
(Config.local_install_dir ~context:t.name)
|
|
|
|
"lib/stublibs")
|
2017-03-01 12:09:57 +00:00
|
|
|
; extend_var "OCAMLPATH" (Path.relative
|
|
|
|
(Config.local_install_dir ~context:t.name)
|
|
|
|
"lib")
|
|
|
|
; extend_var "PATH" (Config.local_install_bin_dir ~context:t.name)
|
2017-03-01 12:56:31 +00:00
|
|
|
; extend_var "MANPATH" (Config.local_install_man_dir ~context:t.name)
|
2017-03-01 12:09:57 +00:00
|
|
|
]
|
|
|
|
in
|
2017-04-24 11:27:13 +00:00
|
|
|
extend_env ~env:t.env ~vars:(Env_var_map.of_alist_exn vars)
|
2017-04-28 09:40:09 +00:00
|
|
|
|
|
|
|
let compiler t (mode : Mode.t) =
|
|
|
|
match mode with
|
|
|
|
| Byte -> Some t.ocamlc
|
|
|
|
| Native -> t.ocamlopt
|
|
|
|
|
|
|
|
let best_mode t : Mode.t =
|
|
|
|
match t.ocamlopt with
|
|
|
|
| Some _ -> Native
|
|
|
|
| None -> Byte
|
2017-06-05 10:40:27 +00:00
|
|
|
|
|
|
|
let cc_g (ctx : t) =
|
|
|
|
if !Clflags.g && ctx.ccomp_type <> "msvc" then
|
|
|
|
["-g"]
|
|
|
|
else
|
|
|
|
[]
|