From b3a6f44f87f5946267d59176d3c7b024bf39b1d0 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Thu, 6 Oct 2005 09:50:12 +0000 Subject: [PATCH] in the end: ... proper handling of multiple bindings of the same key, all "set_*" methods now replace the previous binding --- helm/ocaml/registry/helm_registry.ml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml index d1f4b1f92..35726d4c9 100644 --- a/helm/ocaml/registry/helm_registry.ml +++ b/helm/ocaml/registry/helm_registry.ml @@ -117,10 +117,11 @@ let key_is_valid key = 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 @@ -163,8 +164,6 @@ let get registry key = in List.map strip_blanks (aux [] key) -let set = set' - let has registry key = Hashtbl.mem registry key let get_typed registry unmarshaller key = @@ -172,7 +171,7 @@ 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 @@ -187,7 +186,7 @@ let get_opt_default registry unmarshaller ~default key = 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 @@ -201,8 +200,9 @@ let get_pair registry fst_unmarshaller snd_unmarshaller key = | _ -> 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 = @@ -288,7 +288,7 @@ let rec load_from_absolute ?path registry fname = | "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 () @@ -389,7 +389,7 @@ let ls registry prefix = 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 -- 2.39.2