matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move env related functions to Env module

This commit is contained in:
Rudi Grinberg 2018-03-10 20:33:59 +07:00
parent feba0827b8
commit 8458bf3b15
5 changed files with 85 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/action.ml
View File

@ -1,8 +1,6 @@
open Import
open Sexp.Of_sexp
module Env_var_map = Context.Env_var_map
module Outputs = struct
include Action_intf.Outputs
@ -717,7 +715,7 @@ let exec_run_direct ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args =
invalid_prefix ("_build/" ^ target.name);
invalid_prefix ("_build/install/" ^ target.name);
end;
let env = Context.extend_env ~vars:env_extra ~env:ectx.env in
let env = Env.extend_env ~vars:env_extra ~env:ectx.env in
Process.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to
~purpose:ectx.purpose
(Path.reach_for_running ~from:dir prog) args
@ -743,7 +741,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to
| Setenv (var, value, t) ->
exec t ~ectx ~dir ~stdout_to ~stderr_to
~env_extra:(Env_var_map.add env_extra var value)
~env_extra:(Env.Map.add env_extra var value)
| Redirect (Stdout, fn, Echo s) ->
Io.write_file (Path.to_string fn) s;
Fiber.return ()
@ -894,13 +892,13 @@ and exec_list l ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
let exec ~targets ?context t =
let env =
match (context : Context.t option) with
| None -> Lazy.force Context.initial_env
| None -> Lazy.force Env.initial_env
| Some c -> c.env
in
let targets = Path.Set.to_list targets in
let purpose = Process.Build_job targets in
let ectx = { purpose; context; env } in
exec t ~ectx ~dir:Path.root ~env_extra:Env_var_map.empty
exec t ~ectx ~dir:Path.root ~env_extra:Env.Map.empty
~stdout_to:None ~stderr_to:None
let sandbox t ~sandboxed ~deps ~targets =

79
src/context.ml
View File

@ -18,17 +18,6 @@ module Kind = struct
])
end
module Env_var = struct
type t = string
let compare a b =
if Sys.win32 then
String.compare (String.lowercase a) (String.lowercase b)
else
String.compare a b
end
module Env_var_map = Map.Make(Env_var)
type t =
{ name : string
; kind : Kind.t
@ -45,7 +34,7 @@ type t =
; ocamldep : Path.t
; ocamlmklib : Path.t
; env : string array
; env_extra : string Env_var_map.t
; env_extra : string Env.Map.t
; findlib : Findlib.t
; findlib_toolchain : string option
; arch_sixtyfour : bool
@ -103,7 +92,7 @@ let sexp_of_t t =
; "ocamlopt", option path t.ocamlopt
; "ocamldep", path t.ocamldep
; "ocamlmklib", path t.ocamlmklib
; "env", list (pair string string) (Env_var_map.to_list t.env_extra)
; "env", list (pair string string) (Env.Map.to_list t.env_extra)
; "findlib_path", list path (Findlib.path t.findlib)
; "arch_sixtyfour", bool t.arch_sixtyfour
; "natdynlink_supported", bool t.natdynlink_supported
@ -130,44 +119,12 @@ let opam_config_var ~env ~cache var =
Some s
| Error _ -> None
let get_env env var =
let rec loop i =
if i = Array.length env then
None
else
let entry = env.(i) in
match String.lsplit2 entry ~on:'=' with
| Some (key, value) when Env_var.compare key var = Eq ->
Some value
| _ -> loop (i + 1)
in
loop 0
let which ~cache ~path x =
Hashtbl.find_or_add cache x ~f:(Bin.which ~path)
let extend_env ~vars ~env =
if Env_var_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 (Env_var_map.mem vars key))
in
List.rev_append
(List.map (Env_var_map.to_list vars)
~f:(fun (k, v) -> sprintf "%s=%s" k v))
imported
|> Array.of_list
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
~targets () =
let env = extend_env ~env:base_env ~vars:env_extra in
let env = Env.extend_env ~env:base_env ~vars:env_extra in
let opam_var_cache = Hashtbl.create 128 in
(match kind with
| Opam { root; _ } ->
@ -291,12 +248,12 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
&& version >= (4, 03, 0)
&& version < (4, 05, 0) then
let value =
match get_env env "OCAMLPARAM" with
match Env.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 env_extra "OCAMLPARAM" value)
Env.extend_env ~env ~vars:((Env.Map.singleton "OCAMLPARAM" value)),
(Env.Map.add env_extra "OCAMLPARAM" value)
else
env,env_extra
in
@ -313,7 +270,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
; for_host = host
; build_dir
; path
; toplevel_path = Option.map (get_env env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
; toplevel_path = Option.map (Env.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")
@ -384,18 +341,14 @@ 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 initial_env = lazy (
Lazy.force Colors.setup_env_for_colors;
Unix.environment ())
let default ?(merlin=true) ~targets () =
let env = Lazy.force initial_env in
let env = Lazy.force Env.initial_env in
let path =
match get_env env "PATH" with
match Env.get_env env "PATH" with
| Some s -> Bin.parse_path s
| None -> []
in
create ~kind:Default ~path ~base_env:env ~env_extra:Env_var_map.empty
create ~kind:Default ~path ~base_env:env ~env_extra:Env.Map.empty
~name:"default" ~merlin ~targets ()
let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
@ -413,8 +366,8 @@ let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
let vars =
Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
|> Sexp.Of_sexp.(list (pair string string))
|> Env_var_map.of_list_multi
|> Env_var_map.mapi ~f:(fun var values ->
|> Env.Map.of_list_multi
|> Env.Map.mapi ~f:(fun var values ->
match List.rev values with
| [] -> assert false
| [x] -> x
@ -430,11 +383,11 @@ let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
x)
in
let path =
match Env_var_map.find vars "PATH" with
match Env.Map.find vars "PATH" with
| None -> Bin.path
| Some s -> Bin.parse_path s
in
let env = Lazy.force initial_env in
let env = Lazy.force Env.initial_env in
create ~kind:(Opam { root; switch }) ~targets
~path ~base_env:env ~env_extra:vars ~name ~merlin ()
@ -472,7 +425,7 @@ let env_for_exec t =
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
match Env.get_env t.env var with
| None -> (var, v)
| Some prev -> (var, sprintf "%s%c%s" v sep prev)
in
@ -491,7 +444,7 @@ let env_for_exec t =
(Config.local_install_man_dir ~context:t.name)
]
in
extend_env ~env:t.env ~vars:(Env_var_map.of_list_exn vars)
Env.extend_env ~env:t.env ~vars:(Env.Map.of_list_exn vars)
let compiler t (mode : Mode.t) =
match mode with

13
src/context.mli
View File

@ -30,13 +30,6 @@ module Kind : sig
type t = Default | Opam of Opam.t
end
module Env_var : sig
type t = string
val compare : t -> t -> Ordering.t
end
module Env_var_map : Map.S with type key := Env_var.t
type t =
{ name : string
; kind : Kind.t
@ -73,7 +66,7 @@ type t =
env : string array
; (** Diff between the base environment and [env] *)
env_extra : string Env_var_map.t
env_extra : string Env.Map.t
; findlib : Findlib.t
; findlib_toolchain : string option
@ -135,8 +128,6 @@ val create
val which : t -> string -> Path.t option
val extend_env : vars:string Env_var_map.t -> env:string array -> string array
val opam_config_var : t -> string -> string option Fiber.t
val install_prefix : t -> Path.t Fiber.t
@ -144,8 +135,6 @@ val install_ocaml_libdir : t -> Path.t option Fiber.t
val env_for_exec : t -> string array
val initial_env : string array Lazy.t
(** Return the compiler needed for this compilation mode *)
val compiler : t -> Mode.t -> Path.t option

51
src/env.ml Normal file
View File

@ -0,0 +1,51 @@
open Import
let initial_env = lazy (
Lazy.force Colors.setup_env_for_colors;
Unix.environment ())
module Var = struct
type t = string
let compare a b =
if Sys.win32 then
String.compare (String.lowercase a) (String.lowercase b)
else
String.compare a b
end
let get_env env var =
let rec loop i =
if i = Array.length env then
None
else
let entry = env.(i) in
match String.lsplit2 entry ~on:'=' with
| Some (key, value) when Var.compare key var = Eq ->
Some value
| _ -> loop (i + 1)
in
loop 0
module Map = Map.Make(Var)
let extend_env ~vars ~env =
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

13
src/env.mli Normal file
View File

@ -0,0 +1,13 @@
open Import
module Var : sig
type t = string
end
module Map : Map.S with type key = Var.t
val initial_env : string array Lazy.t
val extend_env : vars:string Map.t -> env:string array -> string array
val get_env : string array -> string -> string option