parent
26d6b03c66
commit
79d47ab68e
115
src/env.ml
115
src/env.ml
|
@ -8,83 +8,92 @@ module Var = struct
|
||||||
else
|
else
|
||||||
String.compare a b
|
String.compare a b
|
||||||
|
|
||||||
|
let equal a b =
|
||||||
|
match compare a b with
|
||||||
|
| Ordering.Eq -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let hash =
|
||||||
|
if Sys.win32 then
|
||||||
|
fun x -> Hashtbl.hash (String.lowercase x)
|
||||||
|
else
|
||||||
|
Hashtbl.hash
|
||||||
end
|
end
|
||||||
|
|
||||||
module Map = Map.Make(Var)
|
module Map = Map.Make(Var)
|
||||||
|
|
||||||
|
module Table = Hashtbl.Make(Var)
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ base : string array
|
{ vars : (Var.t * string) list
|
||||||
; extra : string Map.t
|
|
||||||
; mutable unix : string array option
|
; mutable unix : string array option
|
||||||
}
|
}
|
||||||
|
|
||||||
let make ~base ~extra =
|
let make vars =
|
||||||
{ base
|
{ vars
|
||||||
; extra
|
|
||||||
; unix = None
|
; unix = None
|
||||||
}
|
}
|
||||||
|
|
||||||
let get_env_base env var =
|
let get t k =
|
||||||
let rec loop i =
|
List.find_map t.vars ~f:(fun (k', v) ->
|
||||||
if i = Array.length env then
|
match Var.compare k k' with
|
||||||
None
|
| Ordering.Eq -> Some v
|
||||||
else
|
| _ -> None)
|
||||||
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
|
|
||||||
|
|
||||||
let get t v =
|
|
||||||
match Map.find t.extra v with
|
|
||||||
| None -> get_env_base t.base v
|
|
||||||
| Some _ as v -> v
|
|
||||||
|
|
||||||
let to_unix t =
|
let to_unix t =
|
||||||
match t.unix with
|
match t.unix with
|
||||||
| Some v -> v
|
| Some v -> v
|
||||||
| None ->
|
| None ->
|
||||||
let res =
|
let res =
|
||||||
if Map.is_empty t.extra then
|
let seen = Table.create 16 in
|
||||||
t.base
|
t.vars
|
||||||
else
|
|> List.fold_left ~init:[] ~f:(fun uniques (k, v) ->
|
||||||
let imported =
|
if Table.mem seen k then (
|
||||||
Array.to_list t.base
|
uniques
|
||||||
|> List.filter ~f:(fun s ->
|
) else (
|
||||||
match String.index s '=' with
|
Table.add seen ~key:k ~data:();
|
||||||
| None -> true
|
(k, v) :: uniques
|
||||||
| Some i ->
|
))
|
||||||
let key = String.sub s ~pos:0 ~len:i in
|
|> List.rev_map ~f:(fun (k, v) -> sprintf "%s=%s" k v)
|
||||||
not (Map.mem t.extra key))
|
|> Array.of_list in
|
||||||
in
|
|
||||||
List.rev_append
|
|
||||||
(List.map (Map.to_list t.extra)
|
|
||||||
~f:(fun (k, v) -> sprintf "%s=%s" k v))
|
|
||||||
imported
|
|
||||||
|> Array.of_list in
|
|
||||||
t.unix <- Some res;
|
t.unix <- Some res;
|
||||||
res
|
res
|
||||||
|
|
||||||
|
let of_unix arr =
|
||||||
|
Array.to_list arr
|
||||||
|
|> List.map ~f:(fun s ->
|
||||||
|
match String.lsplit2 s ~on:'=' with
|
||||||
|
| None -> (s, "")
|
||||||
|
| Some (k, v) -> (k, v))
|
||||||
|
|
||||||
let initial =
|
let initial =
|
||||||
let i =
|
let i =
|
||||||
lazy (
|
lazy (
|
||||||
make
|
make (Lazy.force Colors.setup_env_for_colors;
|
||||||
~base:(Lazy.force Colors.setup_env_for_colors;
|
Unix.environment ()
|
||||||
Unix.environment ())
|
|> of_unix)
|
||||||
~extra:Map.empty
|
|
||||||
) in
|
) in
|
||||||
fun () -> Lazy.force i
|
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)
|
|
||||||
)
|
|
||||||
|
|
||||||
let add t ~var ~value =
|
let add t ~var ~value =
|
||||||
make ~base:t.base ~extra:(Map.add t.extra var value)
|
{ vars = (var, value) :: t.vars
|
||||||
|
; unix = None
|
||||||
|
}
|
||||||
|
|
||||||
|
let extend t ~vars =
|
||||||
|
{ vars = Map.foldi ~init:t.vars ~f:(fun k v t -> (k, v) :: t) vars
|
||||||
|
; unix = None
|
||||||
|
}
|
||||||
|
|
||||||
|
let sexp_of_t t =
|
||||||
|
let open Sexp.To_sexp in
|
||||||
|
(list (pair string string)) t.vars
|
||||||
|
|
||||||
|
let diff x y =
|
||||||
|
let to_map b = Map.of_list_reduce b ~f:(fun old _new -> old) in
|
||||||
|
Map.merge (to_map x.vars) (to_map y.vars) ~f:(fun _k vx vy ->
|
||||||
|
match vy with
|
||||||
|
| Some _ -> None
|
||||||
|
| None -> vx)
|
||||||
|
|> Map.to_list
|
||||||
|
|> make
|
||||||
|
|
|
@ -18,3 +18,7 @@ val get : t -> Var.t -> string option
|
||||||
val extend : t -> vars:string Map.t -> t
|
val extend : t -> vars:string Map.t -> t
|
||||||
|
|
||||||
val add : t -> var:Var.t -> value:string -> t
|
val add : t -> var:Var.t -> value:string -> t
|
||||||
|
|
||||||
|
val diff : t -> t -> t
|
||||||
|
|
||||||
|
val sexp_of_t : t -> Sexp.t
|
||||||
|
|
Loading…
Reference in New Issue