Make Env.t abstract
This commit is contained in:
parent
8458bf3b15
commit
35d4153641
|
@ -697,7 +697,7 @@ end
|
||||||
type exec_context =
|
type exec_context =
|
||||||
{ context : Context.t option
|
{ context : Context.t option
|
||||||
; purpose : Process.purpose
|
; purpose : Process.purpose
|
||||||
; env : string array
|
; env : Env.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let exec_run_direct ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args =
|
let exec_run_direct ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args =
|
||||||
|
@ -715,8 +715,9 @@ let exec_run_direct ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args =
|
||||||
invalid_prefix ("_build/" ^ target.name);
|
invalid_prefix ("_build/" ^ target.name);
|
||||||
invalid_prefix ("_build/install/" ^ target.name);
|
invalid_prefix ("_build/install/" ^ target.name);
|
||||||
end;
|
end;
|
||||||
let env = Env.extend_env ~vars:env_extra ~env:ectx.env in
|
let env = Env.extend ectx.env ~vars:env_extra in
|
||||||
Process.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to
|
Process.run Strict ~dir:(Path.to_string dir) ~env:(Env.to_unix env)
|
||||||
|
~stdout_to ~stderr_to
|
||||||
~purpose:ectx.purpose
|
~purpose:ectx.purpose
|
||||||
(Path.reach_for_running ~from:dir prog) args
|
(Path.reach_for_running ~from:dir prog) args
|
||||||
|
|
||||||
|
@ -892,7 +893,7 @@ and exec_list l ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
|
||||||
let exec ~targets ?context t =
|
let exec ~targets ?context t =
|
||||||
let env =
|
let env =
|
||||||
match (context : Context.t option) with
|
match (context : Context.t option) with
|
||||||
| None -> Lazy.force Env.initial_env
|
| None -> Env.initial ()
|
||||||
| Some c -> c.env
|
| Some c -> c.env
|
||||||
in
|
in
|
||||||
let targets = Path.Set.to_list targets in
|
let targets = Path.Set.to_list targets in
|
||||||
|
|
|
@ -33,7 +33,7 @@ type t =
|
||||||
; ocamlopt : Path.t option
|
; ocamlopt : Path.t option
|
||||||
; ocamldep : Path.t
|
; ocamldep : Path.t
|
||||||
; ocamlmklib : Path.t
|
; ocamlmklib : Path.t
|
||||||
; env : string array
|
; env : Env.t
|
||||||
; env_extra : string Env.Map.t
|
; env_extra : string Env.Map.t
|
||||||
; findlib : Findlib.t
|
; findlib : Findlib.t
|
||||||
; findlib_toolchain : string option
|
; findlib_toolchain : string option
|
||||||
|
@ -110,7 +110,8 @@ let opam_config_var ~env ~cache var =
|
||||||
match Bin.opam with
|
match Bin.opam with
|
||||||
| None -> Fiber.return None
|
| None -> Fiber.return None
|
||||||
| Some fn ->
|
| Some fn ->
|
||||||
Process.run_capture (Accept All) (Path.to_string fn) ~env
|
Process.run_capture (Accept All) (Path.to_string fn)
|
||||||
|
~env:(Env.to_unix env)
|
||||||
["config"; "var"; var]
|
["config"; "var"; var]
|
||||||
>>| function
|
>>| function
|
||||||
| Ok s ->
|
| Ok s ->
|
||||||
|
@ -124,7 +125,7 @@ let which ~cache ~path x =
|
||||||
|
|
||||||
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
~targets () =
|
~targets () =
|
||||||
let env = Env.extend_env ~env:base_env ~vars:env_extra in
|
let env = Env.extend base_env ~vars:env_extra in
|
||||||
let opam_var_cache = Hashtbl.create 128 in
|
let opam_var_cache = Hashtbl.create 128 in
|
||||||
(match kind with
|
(match kind with
|
||||||
| Opam { root; _ } ->
|
| Opam { root; _ } ->
|
||||||
|
@ -145,7 +146,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
match Sys.getenv "OCAMLFIND_CONF" with
|
match Sys.getenv "OCAMLFIND_CONF" with
|
||||||
| s -> Fiber.return (Path.absolute s)
|
| s -> Fiber.return (Path.absolute s)
|
||||||
| exception Not_found ->
|
| exception Not_found ->
|
||||||
Process.run_capture_line ~env Strict
|
Process.run_capture_line ~env:(Env.to_unix env) Strict
|
||||||
(Path.to_string fn) ["printconf"; "conf"]
|
(Path.to_string fn) ["printconf"; "conf"]
|
||||||
>>| Path.absolute)
|
>>| Path.absolute)
|
||||||
in
|
in
|
||||||
|
@ -207,7 +208,9 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
| None -> args
|
| None -> args
|
||||||
| Some s -> "-toolchain" :: s :: args
|
| Some s -> "-toolchain" :: s :: args
|
||||||
in
|
in
|
||||||
Process.run_capture_lines ~env Strict (Path.to_string fn) args
|
Process.run_capture_lines
|
||||||
|
~env:(Env.to_unix env)
|
||||||
|
Strict (Path.to_string fn) args
|
||||||
>>| List.map ~f:Path.absolute
|
>>| List.map ~f:Path.absolute
|
||||||
| None ->
|
| None ->
|
||||||
(* If there no ocamlfind in the PATH, check if we have opam
|
(* If there no ocamlfind in the PATH, check if we have opam
|
||||||
|
@ -230,7 +233,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
Fiber.fork_and_join
|
Fiber.fork_and_join
|
||||||
findlib_path
|
findlib_path
|
||||||
(fun () ->
|
(fun () ->
|
||||||
Process.run_capture_lines ~env Strict
|
Process.run_capture_lines ~env:(Env.to_unix env) Strict
|
||||||
(Path.to_string ocamlc) ["-config"]
|
(Path.to_string ocamlc) ["-config"]
|
||||||
>>| fun lines ->
|
>>| fun lines ->
|
||||||
let open Result.O in
|
let open Result.O in
|
||||||
|
@ -248,11 +251,11 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
&& version >= (4, 03, 0)
|
&& version >= (4, 03, 0)
|
||||||
&& version < (4, 05, 0) then
|
&& version < (4, 05, 0) then
|
||||||
let value =
|
let value =
|
||||||
match Env.get_env env "OCAMLPARAM" with
|
match Env.get_var env "OCAMLPARAM" with
|
||||||
| None -> "color=always,_"
|
| None -> "color=always,_"
|
||||||
| Some s -> "color=always," ^ s
|
| Some s -> "color=always," ^ s
|
||||||
in
|
in
|
||||||
Env.extend_env ~env ~vars:((Env.Map.singleton "OCAMLPARAM" value)),
|
Env.extend env ~vars:(Env.Map.singleton "OCAMLPARAM" value),
|
||||||
(Env.Map.add env_extra "OCAMLPARAM" value)
|
(Env.Map.add env_extra "OCAMLPARAM" value)
|
||||||
else
|
else
|
||||||
env,env_extra
|
env,env_extra
|
||||||
|
@ -270,7 +273,8 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
; for_host = host
|
; for_host = host
|
||||||
; build_dir
|
; build_dir
|
||||||
; path
|
; path
|
||||||
; toplevel_path = Option.map (Env.get_env env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
|
; toplevel_path =
|
||||||
|
Option.map (Env.get_var env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
|
||||||
|
|
||||||
; ocaml_bin = dir
|
; ocaml_bin = dir
|
||||||
; ocaml = (match which "ocaml" with Some p -> p | None -> prog_not_found_in_path "ocaml")
|
; ocaml = (match which "ocaml" with Some p -> p | None -> prog_not_found_in_path "ocaml")
|
||||||
|
@ -342,9 +346,9 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
|
||||||
let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var
|
let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var
|
||||||
|
|
||||||
let default ?(merlin=true) ~targets () =
|
let default ?(merlin=true) ~targets () =
|
||||||
let env = Lazy.force Env.initial_env in
|
let env = Env.initial () in
|
||||||
let path =
|
let path =
|
||||||
match Env.get_env env "PATH" with
|
match Env.get_var env "PATH" with
|
||||||
| Some s -> Bin.parse_path s
|
| Some s -> Bin.parse_path s
|
||||||
| None -> []
|
| None -> []
|
||||||
in
|
in
|
||||||
|
@ -387,7 +391,7 @@ let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
|
||||||
| None -> Bin.path
|
| None -> Bin.path
|
||||||
| Some s -> Bin.parse_path s
|
| Some s -> Bin.parse_path s
|
||||||
in
|
in
|
||||||
let env = Lazy.force Env.initial_env in
|
let env = Env.initial () in
|
||||||
create ~kind:(Opam { root; switch }) ~targets
|
create ~kind:(Opam { root; switch }) ~targets
|
||||||
~path ~base_env:env ~env_extra:vars ~name ~merlin ()
|
~path ~base_env:env ~env_extra:vars ~name ~merlin ()
|
||||||
|
|
||||||
|
@ -412,7 +416,7 @@ let install_ocaml_libdir t =
|
||||||
(* If ocamlfind is present, it has precedence over everything else. *)
|
(* If ocamlfind is present, it has precedence over everything else. *)
|
||||||
match which t "ocamlfind" with
|
match which t "ocamlfind" with
|
||||||
| Some fn ->
|
| Some fn ->
|
||||||
(Process.run_capture_line ~env:t.env Strict
|
(Process.run_capture_line ~env:(Env.to_unix t.env) Strict
|
||||||
(Path.to_string fn) ["printconf"; "destdir"]
|
(Path.to_string fn) ["printconf"; "destdir"]
|
||||||
>>| fun s ->
|
>>| fun s ->
|
||||||
Some (Path.absolute s))
|
Some (Path.absolute s))
|
||||||
|
@ -425,7 +429,7 @@ let env_for_exec t =
|
||||||
let cwd = Sys.getcwd () in
|
let cwd = Sys.getcwd () in
|
||||||
let extend_var var v =
|
let extend_var var v =
|
||||||
let v = Filename.concat cwd (Path.to_string v) in
|
let v = Filename.concat cwd (Path.to_string v) in
|
||||||
match Env.get_env t.env var with
|
match Env.get_var t.env var with
|
||||||
| None -> (var, v)
|
| None -> (var, v)
|
||||||
| Some prev -> (var, sprintf "%s%c%s" v sep prev)
|
| Some prev -> (var, sprintf "%s%c%s" v sep prev)
|
||||||
in
|
in
|
||||||
|
@ -444,7 +448,7 @@ let env_for_exec t =
|
||||||
(Config.local_install_man_dir ~context:t.name)
|
(Config.local_install_man_dir ~context:t.name)
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
Env.extend_env ~env:t.env ~vars:(Env.Map.of_list_exn vars)
|
Env.to_unix (Env.extend t.env ~vars:(Env.Map.of_list_exn vars))
|
||||||
|
|
||||||
let compiler t (mode : Mode.t) =
|
let compiler t (mode : Mode.t) =
|
||||||
match mode with
|
match mode with
|
||||||
|
|
|
@ -63,7 +63,7 @@ type t =
|
||||||
; ocamlmklib : Path.t
|
; ocamlmklib : Path.t
|
||||||
|
|
||||||
; (** Environment variables *)
|
; (** Environment variables *)
|
||||||
env : string array
|
env : Env.t
|
||||||
|
|
||||||
; (** Diff between the base environment and [env] *)
|
; (** Diff between the base environment and [env] *)
|
||||||
env_extra : string Env.Map.t
|
env_extra : string Env.Map.t
|
||||||
|
|
79
src/env.ml
79
src/env.ml
|
@ -1,9 +1,5 @@
|
||||||
open Import
|
open Import
|
||||||
|
|
||||||
let initial_env = lazy (
|
|
||||||
Lazy.force Colors.setup_env_for_colors;
|
|
||||||
Unix.environment ())
|
|
||||||
|
|
||||||
module Var = struct
|
module Var = struct
|
||||||
type t = string
|
type t = string
|
||||||
let compare a b =
|
let compare a b =
|
||||||
|
@ -14,7 +10,39 @@ module Var = struct
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let get_env env var =
|
module Map = Map.Make(Var)
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ base : string array
|
||||||
|
; extra : string Map.t
|
||||||
|
; combined : string array Lazy.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let make ~base ~extra =
|
||||||
|
{ base
|
||||||
|
; extra
|
||||||
|
; combined = lazy (
|
||||||
|
if Map.is_empty extra then
|
||||||
|
base
|
||||||
|
else
|
||||||
|
let imported =
|
||||||
|
Array.to_list base
|
||||||
|
|> List.filter ~f:(fun s ->
|
||||||
|
match String.index s '=' with
|
||||||
|
| None -> true
|
||||||
|
| Some i ->
|
||||||
|
let key = String.sub s ~pos:0 ~len:i in
|
||||||
|
not (Map.mem extra key))
|
||||||
|
in
|
||||||
|
List.rev_append
|
||||||
|
(List.map (Map.to_list extra)
|
||||||
|
~f:(fun (k, v) -> sprintf "%s=%s" k v))
|
||||||
|
imported
|
||||||
|
|> Array.of_list
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
let get_env_base env var =
|
||||||
let rec loop i =
|
let rec loop i =
|
||||||
if i = Array.length env then
|
if i = Array.length env then
|
||||||
None
|
None
|
||||||
|
@ -27,25 +55,28 @@ let get_env env var =
|
||||||
in
|
in
|
||||||
loop 0
|
loop 0
|
||||||
|
|
||||||
module Map = Map.Make(Var)
|
let get_var t v =
|
||||||
|
match Map.find t.extra v with
|
||||||
|
| None -> get_env_base t.base v
|
||||||
|
| Some _ as v -> v
|
||||||
|
|
||||||
let extend_env ~vars ~env =
|
let to_unix t = Lazy.force t.combined
|
||||||
if Map.is_empty vars then
|
|
||||||
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
|
|
||||||
not (Map.mem vars key))
|
|
||||||
in
|
|
||||||
List.rev_append
|
|
||||||
(List.map (Map.to_list vars)
|
|
||||||
~f:(fun (k, v) -> sprintf "%s=%s" k v))
|
|
||||||
imported
|
|
||||||
|> Array.of_list
|
|
||||||
|
|
||||||
|
let initial =
|
||||||
|
let i =
|
||||||
|
lazy (
|
||||||
|
make
|
||||||
|
~base:(Lazy.force Colors.setup_env_for_colors;
|
||||||
|
Unix.environment ())
|
||||||
|
~extra:Map.empty
|
||||||
|
) in
|
||||||
|
fun () -> Lazy.force i
|
||||||
|
|
||||||
|
let extend t ~vars =
|
||||||
|
make ~base:t.base
|
||||||
|
~extra:(
|
||||||
|
Map.merge t.extra vars ~f:(fun _ v1 v2 ->
|
||||||
|
match v2 with
|
||||||
|
| Some _ -> v2
|
||||||
|
| None -> v1)
|
||||||
|
)
|
||||||
|
|
11
src/env.mli
11
src/env.mli
|
@ -2,12 +2,17 @@ open Import
|
||||||
|
|
||||||
module Var : sig
|
module Var : sig
|
||||||
type t = string
|
type t = string
|
||||||
|
val compare : t -> t -> Ordering.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
type t
|
||||||
|
|
||||||
module Map : Map.S with type key = Var.t
|
module Map : Map.S with type key = Var.t
|
||||||
|
|
||||||
val initial_env : string array Lazy.t
|
val initial : unit -> t
|
||||||
|
|
||||||
val extend_env : vars:string Map.t -> env:string array -> string array
|
val to_unix : t -> string array
|
||||||
|
|
||||||
val get_env : string array -> string -> string option
|
val get_var : t -> Var.t -> string option
|
||||||
|
|
||||||
|
val extend : t -> vars:string Map.t -> t
|
||||||
|
|
|
@ -148,7 +148,8 @@ end
|
||||||
in
|
in
|
||||||
]}
|
]}
|
||||||
*)
|
*)
|
||||||
Process.run Strict ~dir:(Path.to_string dir) ~env:context.env
|
Process.run Strict ~dir:(Path.to_string dir)
|
||||||
|
~env:(Env.to_unix context.env)
|
||||||
(Path.to_string context.ocaml)
|
(Path.to_string context.ocaml)
|
||||||
args
|
args
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
|
|
Loading…
Reference in New Issue