+let set' ?(replace=false) registry ~key ~value =
+ debug_print (lazy(sprintf "Setting (replace: %b) %s = %s" replace key value));
+ key_is_valid key;
+ let add_fun = if replace then Hashtbl.replace else Hashtbl.add in
+ add_fun registry key value
+
+let unset registry = Hashtbl.remove registry
+
+let env_var_of_key = Str.global_replace dot_rex "__"
+
+let singleton = function
+ | [] ->
+ raise (Type_error ("empty list value found where singleton was expected"))
+ | hd :: _ -> hd
+
+let get registry key =
+ let rec aux stack key =
+ key_is_valid key;
+ if List.mem key stack then begin
+ let msg = (String.concat " -> " (List.rev stack)) ^ " -> " ^ key in
+ raise (Cyclic_definition msg)
+ end;
+ (* internal value *)
+ let registry_values = List.rev (Hashtbl.find_all registry key) in
+ let env_value = (* environment value *)
+ try
+ Some (Sys.getenv (env_var_of_key key))
+ with Not_found -> None
+ in
+ let values = (* resulting value *)
+ match registry_values, env_value with
+ | _, Some env -> [env]
+ | [], None -> raise (Key_not_found key)
+ | values, None -> values
+ in
+ List.map (interpolate (key :: stack)) values
+ and interpolate stack value =
+ Str.global_substitute interpolated_key_rex
+ (fun s ->
+ let matched = Str.matched_string s in
+ (* "$(var)" -> "var" *)
+ let key = String.sub matched 2 (String.length matched - 3) in
+ singleton (aux stack key))
+ value
+ in
+ List.map strip_blanks (aux [] key)
+
+let has registry key = Hashtbl.mem registry key
+
+let get_typed registry unmarshaller key =
+ let value = singleton (get registry key) in
+ unmarshaller value
+
+let set_typed registry marshaller ~key ~value =
+ set' ~replace:true registry ~key ~value:(marshaller value)
+
+let get_opt registry unmarshaller key =
+ try
+ Some (unmarshaller (singleton (get registry key)))
+ with Key_not_found _ -> None
+
+let get_opt_default registry unmarshaller ~default key =
+ match get_opt registry unmarshaller key with
+ | None -> default
+ | Some v -> v
+
+let set_opt registry marshaller ~key ~value =
+ match value with
+ | None -> unset registry key
+ | Some value -> set' ~replace:true registry ~key ~value:(marshaller value)
+
+let get_list registry unmarshaller key =
+ try
+ List.map unmarshaller (get registry key)
+ with Key_not_found _ -> []
+
+let get_pair registry fst_unmarshaller snd_unmarshaller key =
+ let v = singleton (get registry key) in
+ match Str.split spaces_rex v with
+ | [fst; snd] -> fst_unmarshaller fst, snd_unmarshaller snd
+ | _ -> raise (Type_error "not a pair")
+
+let set_list registry marshaller ~key ~value =
+ Hashtbl.remove registry key;