2018-03-10 13:33:59 +00:00
|
|
|
open Import
|
|
|
|
|
|
|
|
module Var = struct
|
|
|
|
type t = string
|
2018-03-12 03:47:56 +00:00
|
|
|
let compare =
|
|
|
|
if Sys.win32 then (
|
|
|
|
fun a b -> String.compare (String.lowercase a) (String.lowercase b)
|
|
|
|
) else (
|
|
|
|
String.compare
|
|
|
|
)
|
2018-03-10 13:33:59 +00:00
|
|
|
end
|
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
module Map = Map.Make(Var)
|
|
|
|
|
|
|
|
type t =
|
2018-03-12 09:56:19 +00:00
|
|
|
{ vars : string Map.t
|
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-04-30 17:13:50 +00:00
|
|
|
let empty = make Map.empty
|
|
|
|
|
2018-03-12 09:56:19 +00:00
|
|
|
let get t k = Map.find t.vars k
|
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 09:56:19 +00:00
|
|
|
Map.foldi ~init:[] ~f:(fun k v acc ->
|
|
|
|
(sprintf "%s=%s" k v)::acc
|
|
|
|
) t.vars
|
2018-03-12 03:43:43 +00:00
|
|
|
|> 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
|
2018-03-12 09:56:19 +00:00
|
|
|
| None ->
|
2018-04-23 07:04:15 +00:00
|
|
|
Exn.code_error "Env.of_unix: entry without '=' found in the environ"
|
2018-03-12 09:56:19 +00:00
|
|
|
["var", Sexp.To_sexp.string s]
|
2018-03-12 03:43:43 +00:00
|
|
|
| Some (k, v) -> (k, v))
|
2018-03-20 14:02:49 +00:00
|
|
|
|> Map.of_list_multi
|
|
|
|
|> Map.map ~f:(function
|
|
|
|
| [] -> assert false
|
|
|
|
| x::_ -> x)
|
2018-03-12 03:43:43 +00:00
|
|
|
|
2018-03-29 15:58:41 +00:00
|
|
|
let initial = make (of_unix (Unix.environment ()))
|
2018-03-10 13:33:59 +00:00
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
let add t ~var ~value =
|
2018-03-12 09:56:19 +00:00
|
|
|
make (Map.add t.vars var value)
|
2018-03-12 03:43:43 +00:00
|
|
|
|
2018-03-10 14:15:02 +00:00
|
|
|
let extend t ~vars =
|
2018-03-12 09:56:19 +00:00
|
|
|
make (Map.union t.vars vars ~f:(fun _ _ v -> Some v))
|
2018-03-11 04:45:47 +00:00
|
|
|
|
2018-03-15 10:18:15 +00:00
|
|
|
let extend_env x y =
|
|
|
|
extend x ~vars:y.vars
|
|
|
|
|
2018-03-12 03:43:43 +00:00
|
|
|
let sexp_of_t t =
|
|
|
|
let open Sexp.To_sexp in
|
2018-03-12 09:56:19 +00:00
|
|
|
(list (pair string string)) (Map.to_list t.vars)
|
2018-03-12 03:43:43 +00:00
|
|
|
|
|
|
|
let diff x y =
|
2018-03-12 09:56:19 +00:00
|
|
|
Map.merge x.vars y.vars ~f:(fun _k vx vy ->
|
2018-03-12 03:43:43 +00:00
|
|
|
match vy with
|
|
|
|
| Some _ -> None
|
|
|
|
| None -> vx)
|
|
|
|
|> make
|
2018-03-22 14:42:42 +00:00
|
|
|
|
|
|
|
let update t ~var ~f =
|
|
|
|
make (Map.update t.vars var ~f)
|
2018-04-30 17:13:50 +00:00
|
|
|
|
|
|
|
let of_string_map m =
|
|
|
|
make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m)
|