X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fregistry%2Fhelm_registry.ml;h=35726d4c966868d20465c9374fb21bac1d1c8d29;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=78d8cda5fa315dc6572e56cde619e7a51e1d43bc;hpb=c8162cf506d5e2444e9dee5ae91293013a8b0a43;p=helm.git

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index 78d8cda5f..35726d4c9 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -117,13 +117,11 @@ let key_is_valid key =
   if not (Str.string_match valid_key_rex key 0) then
     raise (Malformed_key key)
 
-let set' ?(replace=true) 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;
-  if replace then
-    Hashtbl.replace registry key value
-  else
-    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
 
@@ -166,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 =
@@ -175,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
@@ -190,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
@@ -204,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 ~replace:false registry ~key ~value:(marshaller v))
+    (fun v -> set' ~replace:false registry ~key ~value:(marshaller v))
     value
 
 type xml_tree =
@@ -291,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 ()
@@ -392,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