]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/registry/helm_registry.ml
- "load_from" no longer clears the previous registry, but instead merge it with loade...
[helm.git] / helm / ocaml / registry / helm_registry.ml
index b0fcdab857f417474e1e3f8d3476e47a9c2b6862..78d8cda5fa315dc6572e56cde619e7a51e1d43bc 100644 (file)
@@ -117,10 +117,13 @@ 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 =
+let set' ?(replace=true) registry ~key ~value =
   debug_print (lazy (sprintf "Setting %s = %s" key value));
   key_is_valid key;
-  Hashtbl.add registry key value
+  if replace then
+    Hashtbl.replace registry key value
+  else
+    Hashtbl.add registry key value
 
 let unset registry = Hashtbl.remove registry
 
@@ -163,7 +166,7 @@ let get registry key =
   in
   List.map strip_blanks (aux [] key)
 
-let set registry = set' registry
+let set = set'
 
 let has registry key = Hashtbl.mem registry key
 
@@ -201,7 +204,9 @@ let get_pair registry fst_unmarshaller snd_unmarshaller key =
   | _ -> raise (Type_error "not a pair")
 
 let set_list registry marshaller ~key ~value =
-  List.iter (fun v -> set registry ~key ~value:(marshaller v)) value
+  List.iter
+    (fun v -> set ~replace:false registry ~key ~value:(marshaller v))
+    value
 
 type xml_tree =
   | Cdata of string
@@ -304,7 +309,7 @@ let rec load_from_absolute ?path registry fname =
   } in
   let xml_parser = XmlPushParser.create_parser callbacks in
   let backup = backup_registry registry in
-  if path = None then Hashtbl.clear registry;
+(*   if path = None then Hashtbl.clear registry; *)
   try
     XmlPushParser.parse xml_parser (`File fname)
   with exn ->
@@ -405,6 +410,7 @@ let set_list marshaller = set_list default_registry marshaller
 let unset = unset default_registry
 let save_to = save_to default_registry
 let load_from = load_from default_registry
+let clear () = Hashtbl.clear default_registry
 
 let get_string = get_typed string
 let get_int = get_typed int