Merge pull request #523 from rgrinberg/ocamlc-config-module
Move reading/reading ocamlc -config to own module
This commit is contained in:
commit
4666359acf
|
@ -51,7 +51,7 @@ type t =
|
||||||
; arch_sixtyfour : bool
|
; arch_sixtyfour : bool
|
||||||
; opam_var_cache : (string, string) Hashtbl.t
|
; opam_var_cache : (string, string) Hashtbl.t
|
||||||
; natdynlink_supported : bool
|
; natdynlink_supported : bool
|
||||||
; ocamlc_config : (string * string) list
|
; ocamlc_config : Ocamlc_config.t
|
||||||
; version_string : string
|
; version_string : string
|
||||||
; version : int * int * int
|
; version : int * int * int
|
||||||
; stdlib_dir : Path.t
|
; stdlib_dir : Path.t
|
||||||
|
@ -109,7 +109,7 @@ let sexp_of_t t =
|
||||||
; "arch_sixtyfour", bool t.arch_sixtyfour
|
; "arch_sixtyfour", bool t.arch_sixtyfour
|
||||||
; "natdynlink_supported", bool t.natdynlink_supported
|
; "natdynlink_supported", bool t.natdynlink_supported
|
||||||
; "opam_vars", atom_hashtbl atom t.opam_var_cache
|
; "opam_vars", atom_hashtbl atom t.opam_var_cache
|
||||||
; "ocamlc_config", list (pair atom atom) t.ocamlc_config
|
; "ocamlc_config", Ocamlc_config.sexp_of_t t.ocamlc_config
|
||||||
; "which", atom_hashtbl (option path) t.which_cache
|
; "which", atom_hashtbl (option path) t.which_cache
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -215,15 +215,13 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
>>= fun findlib_config ->
|
>>= fun findlib_config ->
|
||||||
|
|
||||||
let get_tool_using_findlib_config prog =
|
let get_tool_using_findlib_config prog =
|
||||||
match findlib_config with
|
Option.bind findlib_config ~f:(fun conf ->
|
||||||
| None -> None
|
|
||||||
| Some conf ->
|
|
||||||
match Findlib.Config.get conf prog with
|
match Findlib.Config.get conf prog with
|
||||||
| "" -> None
|
| "" -> None
|
||||||
| s ->
|
| s ->
|
||||||
match Filename.analyze_program_name s with
|
match Filename.analyze_program_name s with
|
||||||
| In_path | Relative_to_current_dir -> which s
|
| In_path | Relative_to_current_dir -> which s
|
||||||
| Absolute -> Some (Path.absolute s)
|
| Absolute -> Some (Path.absolute s))
|
||||||
in
|
in
|
||||||
|
|
||||||
let ocamlc =
|
let ocamlc =
|
||||||
|
@ -251,7 +249,6 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
in
|
in
|
||||||
|
|
||||||
let build_dir = Path.of_string (sprintf "_build/%s" name) in
|
let build_dir = Path.of_string (sprintf "_build/%s" name) in
|
||||||
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
|
|
||||||
let findlib_path () =
|
let findlib_path () =
|
||||||
if use_findlib then
|
if use_findlib then
|
||||||
(* If ocamlfind is present, it has precedence over everything else. *)
|
(* If ocamlfind is present, it has precedence over everything else. *)
|
||||||
|
@ -280,47 +277,9 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
in
|
in
|
||||||
Fiber.fork_and_join
|
Fiber.fork_and_join
|
||||||
findlib_path
|
findlib_path
|
||||||
(fun () ->
|
(fun () -> Ocamlc_config.read ~ocamlc ~env)
|
||||||
Process.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"])
|
|
||||||
>>= fun (findlib_path, ocamlc_config) ->
|
>>= fun (findlib_path, ocamlc_config) ->
|
||||||
|
let version = Ocamlc_config.version ocamlc_config in
|
||||||
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
|
|
||||||
| None ->
|
|
||||||
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
|
|
||||||
let version_string = get "version" in
|
|
||||||
let version = Scanf.sscanf version_string "%u.%u.%u" (fun a b c -> a, b, c) in
|
|
||||||
let env, env_extra =
|
let env, env_extra =
|
||||||
(* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05,
|
(* 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
|
OCAML_COLOR is not supported so we use OCAMLPARAM. OCaml 4.02 doesn't support
|
||||||
|
@ -339,37 +298,15 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
else
|
else
|
||||||
env,env_extra
|
env,env_extra
|
||||||
in
|
in
|
||||||
let split_prog s =
|
let stdlib_dir = Ocamlc_config.stdlib_dir ocamlc_config in
|
||||||
let len = String.length s in
|
let natdynlink_supported = Ocamlc_config.natdynlink_supported ocamlc_config in
|
||||||
let rec loop i =
|
let version = Ocamlc_config.version ocamlc_config in
|
||||||
if i = len then
|
let version_string = Ocamlc_config.version_string ocamlc_config in
|
||||||
(s, "")
|
let get = Ocamlc_config.get ocamlc_config in
|
||||||
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
|
|
||||||
let c_compiler, ocamlc_cflags, ocamlopt_cflags =
|
let c_compiler, ocamlc_cflags, ocamlopt_cflags =
|
||||||
match get_opt "c_compiler" with
|
Ocamlc_config.c_compiler_settings ocamlc_config in
|
||||||
| Some c_compiler -> (* >= 4.06 *)
|
|
||||||
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")
|
|
||||||
| None ->
|
|
||||||
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 =
|
let arch_sixtyfour =
|
||||||
match get_opt "word_size" with
|
match Ocamlc_config.word_size ocamlc_config with
|
||||||
| Some ws -> ws = "64"
|
| Some ws -> ws = "64"
|
||||||
| None -> get_arch_sixtyfour stdlib_dir
|
| None -> get_arch_sixtyfour stdlib_dir
|
||||||
in
|
in
|
||||||
|
@ -401,7 +338,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
; natdynlink_supported
|
; natdynlink_supported
|
||||||
|
|
||||||
; stdlib_dir
|
; stdlib_dir
|
||||||
; ocamlc_config = String_map.bindings ocamlc_config
|
; ocamlc_config
|
||||||
; version_string
|
; version_string
|
||||||
; version
|
; version
|
||||||
; ccomp_type = get "ccomp_type"
|
; ccomp_type = get "ccomp_type"
|
||||||
|
@ -423,7 +360,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
; default_executable_name = get "default_executable_name"
|
; default_executable_name = get "default_executable_name"
|
||||||
; host = get "host"
|
; host = get "host"
|
||||||
; target = get "target"
|
; target = get "target"
|
||||||
; flambda = get_bool "flambda" ~default:false
|
; flambda = Ocamlc_config.flambda ocamlc_config
|
||||||
; exec_magic_number = get "exec_magic_number"
|
; exec_magic_number = get "exec_magic_number"
|
||||||
; cmi_magic_number = get "cmi_magic_number"
|
; cmi_magic_number = get "cmi_magic_number"
|
||||||
; cmo_magic_number = get "cmo_magic_number"
|
; cmo_magic_number = get "cmo_magic_number"
|
||||||
|
|
|
@ -86,8 +86,7 @@ type t =
|
||||||
; (** Native dynlink *)
|
; (** Native dynlink *)
|
||||||
natdynlink_supported : bool
|
natdynlink_supported : bool
|
||||||
|
|
||||||
; (** Output of [ocamlc -config] *)
|
; ocamlc_config : Ocamlc_config.t
|
||||||
ocamlc_config : (string * string) list
|
|
||||||
; version_string : string
|
; version_string : string
|
||||||
; version : int * int * int
|
; version : int * int * int
|
||||||
; stdlib_dir : Path.t
|
; stdlib_dir : Path.t
|
||||||
|
|
|
@ -453,6 +453,8 @@ module Option = struct
|
||||||
| Some a -> f a
|
| Some a -> f a
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let bind t ~f = Infix.(>>=) t f
|
||||||
|
|
||||||
let map t ~f =
|
let map t ~f =
|
||||||
match t with
|
match t with
|
||||||
| None -> None
|
| None -> None
|
||||||
|
|
|
@ -92,10 +92,7 @@ end
|
||||||
%s|}
|
%s|}
|
||||||
context.name
|
context.name
|
||||||
context.version_string
|
context.version_string
|
||||||
(String.concat ~sep:"\n ; "
|
(Ocamlc_config.ocaml_value context.ocamlc_config)
|
||||||
(let longest = List.longest_map context.ocamlc_config ~f:fst in
|
|
||||||
List.map context.ocamlc_config ~f:(fun (k, v) ->
|
|
||||||
Printf.sprintf "%-*S , %S" (longest + 2) k v)))
|
|
||||||
(Path.reach ~from:exec_dir target)
|
(Path.reach ~from:exec_dir target)
|
||||||
plugin plugin_contents);
|
plugin plugin_contents);
|
||||||
extract_requires ~fname:plugin plugin_contents
|
extract_requires ~fname:plugin plugin_contents
|
||||||
|
|
|
@ -0,0 +1,102 @@
|
||||||
|
open Import
|
||||||
|
open Fiber.O
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ bindings: string String_map.t
|
||||||
|
; ocamlc: Path.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let ocamlc_config_cmd ocamlc =
|
||||||
|
sprintf "%s -config" (Path.to_string ocamlc)
|
||||||
|
|
||||||
|
let sexp_of_t t =
|
||||||
|
let open Sexp.To_sexp in
|
||||||
|
atom_map atom t.bindings
|
||||||
|
|
||||||
|
let read ~ocamlc ~env =
|
||||||
|
Process.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"]
|
||||||
|
>>| fun lines ->
|
||||||
|
List.map lines ~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 ocamlc) line)
|
||||||
|
|> String_map.of_alist
|
||||||
|
|> function
|
||||||
|
| Ok bindings -> { bindings ; ocamlc }
|
||||||
|
| Error (key, _, _) ->
|
||||||
|
die "variable %S present twice in the output of `%s`"
|
||||||
|
key (ocamlc_config_cmd ocamlc)
|
||||||
|
|
||||||
|
let ocaml_value t =
|
||||||
|
let t = String_map.bindings t.bindings in
|
||||||
|
let longest = List.longest_map t ~f:fst in
|
||||||
|
List.map t ~f:(fun (k, v) -> sprintf "%-*S , %S" (longest + 2) k v)
|
||||||
|
|> String.concat ~sep:"\n ; "
|
||||||
|
|
||||||
|
let get_opt t var = String_map.find var t.bindings
|
||||||
|
|
||||||
|
let get ?default t var =
|
||||||
|
match get_opt t var with
|
||||||
|
| Some s -> s
|
||||||
|
| None ->
|
||||||
|
match default with
|
||||||
|
| Some x -> x
|
||||||
|
| None ->
|
||||||
|
die "variable %S not found in the output of `%s`" var
|
||||||
|
(ocamlc_config_cmd t.ocamlc)
|
||||||
|
|
||||||
|
let get_bool ?default t var =
|
||||||
|
match get t ?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 t.ocamlc)
|
||||||
|
|
||||||
|
let get_path t var = Path.absolute (get t var)
|
||||||
|
|
||||||
|
let stdlib_dir t = get_path t "standard_library"
|
||||||
|
|
||||||
|
let natdynlink_supported t =
|
||||||
|
Path.exists (Path.relative (stdlib_dir t) "dynlink.cmxa")
|
||||||
|
|
||||||
|
let version_string t = get t "version"
|
||||||
|
|
||||||
|
let version t = Scanf.sscanf (version_string t) "%u.%u.%u" (fun a b c -> a, b, c)
|
||||||
|
|
||||||
|
let word_size t = get_opt t "word_size"
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
let c_compiler_settings t =
|
||||||
|
match get_opt t "c_compiler" with
|
||||||
|
| Some c_compiler -> (* >= 4.06 *)
|
||||||
|
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 t var)
|
||||||
|
else
|
||||||
|
get t var in
|
||||||
|
(c_compiler, args "ocamlc_cflags", args "ocamlopt_cflags")
|
||||||
|
| None ->
|
||||||
|
let c_compiler, ocamlc_cflags = split_prog (get t "bytecomp_c_compiler") in
|
||||||
|
let _, ocamlopt_cflags = split_prog (get t "native_c_compiler") in
|
||||||
|
(c_compiler, ocamlc_cflags, ocamlopt_cflags)
|
||||||
|
|
||||||
|
let flambda t = get_bool t "flambda" ~default:false
|
|
@ -0,0 +1,19 @@
|
||||||
|
(** Output of [ocamlc -config] *)
|
||||||
|
type t
|
||||||
|
|
||||||
|
val sexp_of_t : t -> Sexp.t
|
||||||
|
|
||||||
|
val read : ocamlc:Path.t -> env:string array -> t Fiber.t
|
||||||
|
|
||||||
|
(** Used to pass these settings to jbuild files using the OCaml syntax *)
|
||||||
|
val ocaml_value : t -> string
|
||||||
|
|
||||||
|
val get : ?default:string -> t -> string -> string
|
||||||
|
|
||||||
|
val natdynlink_supported : t -> bool
|
||||||
|
val version : t -> (int * int * int)
|
||||||
|
val version_string : t -> string
|
||||||
|
val word_size : t -> string option
|
||||||
|
val flambda : t -> bool
|
||||||
|
val stdlib_dir : t -> Path.t
|
||||||
|
val c_compiler_settings : t -> (string * string * string)
|
Loading…
Reference in New Issue