if not (Str.string_match valid_key_rex key 0) then
raise (Malformed_key key)
-let set' registry ~key ~value =
- debug_print (lazy (sprintf "Setting %s = %s" key value));
+let set' ?(replace=false) registry ~key ~value =
+ debug_print (lazy(sprintf "Setting (replace: %b) %s = %s" replace key value));
key_is_valid key;
- Hashtbl.add registry key value
+ let add_fun = if replace then Hashtbl.replace else Hashtbl.add in
+ add_fun registry key value
let unset registry = Hashtbl.remove registry
in
List.map strip_blanks (aux [] key)
-let set = set'
-
let has registry key = Hashtbl.mem registry key
let get_typed registry unmarshaller key =
unmarshaller value
let set_typed registry marshaller ~key ~value =
- set registry ~key ~value:(marshaller value)
+ set' ~replace:true registry ~key ~value:(marshaller value)
let get_opt registry unmarshaller key =
try
let set_opt registry marshaller ~key ~value =
match value with
| None -> unset registry key
- | Some value -> set registry ~key ~value:(marshaller value)
+ | Some value -> set' ~replace:true registry ~key ~value:(marshaller value)
let get_list registry unmarshaller key =
try
| _ -> raise (Type_error "not a pair")
let set_list registry marshaller ~key ~value =
+ Hashtbl.remove registry key;
List.iter
- (fun v -> set registry ~key ~value:(marshaller v))
+ (fun v -> set' ~replace:false registry ~key ~value:(marshaller v))
value
type xml_tree =
| "section" -> pop_path ()
| "key" ->
let key = String.concat "." (List.rev !_path) in
- set registry ~key ~value:!cdata;
+ set' registry ~key ~value:!cdata;
cdata := "";
in_key := false;
pop_path ()
let default_registry = Hashtbl.create magic_size
let get key = singleton (get default_registry key)
-let set = set default_registry
+let set = set' ~replace:true default_registry
let has = has default_registry
let fold ?prefix ?interpolate f init =
fold default_registry ?prefix ?interpolate f init