2018-03-10 13:33:59 +00:00
|
|
|
open Import
|
|
|
|
|
|
|
|
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
|
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
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
|
2018-03-10 13:33:59 +00:00
|
|
|
end
|
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
module Map = Map.Make(Var)
|
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
module Table = Hashtbl.Make(Var)
|
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
type t =
|
2018-03-12 03:43:43 +00:00
|
|
|
{ vars : (Var.t * string) list
|
2018-03-12 02:52:52 +00:00
|
|
|
; mutable unix : string array option
|
2018-03-10 14:15:02 +00:00
|
|
|
}
|
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
let make vars =
|
|
|
|
{ vars
|
2018-03-12 02:52:52 +00:00
|
|
|
; unix = None
|
2018-03-10 14:15:02 +00:00
|
|
|
}
|
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
let get t k =
|
|
|
|
List.find_map t.vars ~f:(fun (k', v) ->
|
|
|
|
match Var.compare k k' with
|
|
|
|
| Ordering.Eq -> Some v
|
|
|
|
| _ -> None)
|
2018-03-10 13:33:59 +00:00
|
|
|
|
2018-03-12 02:52:52 +00:00
|
|
|
let to_unix t =
|
|
|
|
match t.unix with
|
|
|
|
| Some v -> v
|
|
|
|
| None ->
|
|
|
|
let res =
|
2018-03-12 03:43:43 +00:00
|
|
|
let seen = Table.create 16 in
|
|
|
|
t.vars
|
|
|
|
|> List.fold_left ~init:[] ~f:(fun uniques (k, v) ->
|
|
|
|
if Table.mem seen k then (
|
|
|
|
uniques
|
|
|
|
) else (
|
|
|
|
Table.add seen ~key:k ~data:();
|
|
|
|
(k, v) :: uniques
|
|
|
|
))
|
|
|
|
|> List.rev_map ~f:(fun (k, v) -> sprintf "%s=%s" k v)
|
|
|
|
|> Array.of_list in
|
2018-03-12 02:52:52 +00:00
|
|
|
t.unix <- Some res;
|
|
|
|
res
|
2018-03-10 13:33:59 +00:00
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
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))
|
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
let initial =
|
|
|
|
let i =
|
|
|
|
lazy (
|
2018-03-12 03:43:43 +00:00
|
|
|
make (Lazy.force Colors.setup_env_for_colors;
|
|
|
|
Unix.environment ()
|
|
|
|
|> of_unix)
|
2018-03-10 14:15:02 +00:00
|
|
|
) in
|
|
|
|
fun () -> Lazy.force i
|
2018-03-10 13:33:59 +00:00
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
let add t ~var ~value =
|
|
|
|
{ vars = (var, value) :: t.vars
|
|
|
|
; unix = None
|
|
|
|
}
|
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
let extend t ~vars =
|
2018-03-12 03:43:43 +00:00
|
|
|
{ vars = Map.foldi ~init:t.vars ~f:(fun k v t -> (k, v) :: t) vars
|
|
|
|
; unix = None
|
|
|
|
}
|
2018-03-11 04:45:47 +00:00
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
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
|