1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
module Sys = Stdlib.Sys
module Var = struct
module T = struct
type t = string
let compare =
if Sys.win32
then fun a b -> String.compare (String.lowercase a) (String.lowercase b)
else String.compare
;;
let to_dyn = Dyn.string
end
let temp_dir = if Sys.win32 then "TEMP" else "TMPDIR"
include Comparable.Make (T)
include T
end
module Set = Var.Set
module Map = Var.Map
type t =
{ vars : string Map.t
; mutable unix : string list option
}
let equal t { vars; unix = _ } = Map.equal ~equal:String.equal t.vars vars
let hash { vars; unix = _ } = Poly.hash vars
let of_map vars = { vars; unix = None }
let empty = of_map Map.empty
let vars t = Var.Set.of_keys t.vars
let get t k = Map.find t.vars k
let to_unix t =
match t.unix with
| Some v -> v
| None ->
let res =
Map.foldi ~init:[] ~f:(fun k v acc -> Printf.sprintf "%s=%s" k v :: acc) t.vars
in
t.unix <- Some res;
res
;;
let of_unix arr =
Array.to_list arr
|> List.map ~f:(fun s ->
match String.lsplit2 s ~on:'=' with
| None ->
Code_error.raise
"Env.of_unix: entry without '=' found in the environment"
[ "var", String s ]
| Some (k, v) -> k, v)
|> Map.of_list_multi
|> Map.map ~f:(function
| [] -> assert false
| x :: _ -> x)
;;
let initial = of_map (of_unix (Unix.environment ()))
let of_unix u = of_map (of_unix u)
let add t ~var ~value = of_map (Map.set t.vars var value)
let mem t ~var = Map.mem t.vars var
let remove t ~var = of_map (Map.remove t.vars var)
let extend t ~vars = if Map.is_empty vars then t else of_map (Map.superpose vars t.vars)
let extend_env x y = if Map.is_empty x.vars then y else extend x ~vars:y.vars
let to_dyn t =
let open Dyn in
Map.to_dyn string t.vars
;;
let diff x y =
Map.merge x.vars y.vars ~f:(fun _k vx vy ->
match vy with
| Some _ -> None
| None -> vx)
|> of_map
;;
let update t ~var ~f = of_map (Map.update t.vars var ~f)
let of_string_map m =
of_map (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.set acc k v) m)
;;
let iter t = Map.iteri t.vars
let to_map t = t.vars