]> matita.cs.unibo.it Git - helm.git/blobdiff - components/registry/helm_registry.ml
fast and sound registry lists
[helm.git] / components / registry / helm_registry.ml
index b7b3de11d6c48eb4c269da61cd0b60cb07e3d36a..fd0df50136add3246c4e2f1aff7734fad05c0d7f 100644 (file)
@@ -109,6 +109,12 @@ let of_int = handle_type_error string_of_int
 let of_float = handle_type_error string_of_float
 let of_bool = handle_type_error string_of_bool
 
+(* FG *)
+let pair fst_unmarshaller snd_unmarshaller v =
+  match Str.split spaces_rex v with
+  | [fst; snd] -> fst_unmarshaller fst, snd_unmarshaller snd
+  | _ -> raise (Type_error "not a pair")
+
   (* escapes for xml configuration file *)
 let (escape, unescape) =
   let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in
@@ -127,7 +133,7 @@ let set' ?(replace=false) registry ~key ~value =
 
 let unset registry = Hashtbl.remove registry
 
-let env_var_of_key = Str.global_replace dot_rex "__"
+let env_var_of_key s = String.uppercase (Str.global_replace dot_rex "_" s)
 
 let singleton = function
   | [] ->
@@ -195,20 +201,21 @@ let set_opt registry marshaller ~key ~value =
 
 let get_list registry unmarshaller key =
   try
-    List.map unmarshaller (get registry key)
+    let tmp = get registry key in
+    let rc = List.map unmarshaller tmp in
+    rc
   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")
+(* FG *)
+let get_pair registry fst_unmarshaller snd_unmarshaller =
+  get_typed registry (pair fst_unmarshaller snd_unmarshaller) 
 
 let set_list registry marshaller ~key ~value =
-  Hashtbl.remove registry key;
-  List.iter
-    (fun v -> set' ~replace:false registry ~key ~value:(marshaller v))
-    value
+  (* since ocaml hash table are crazy... *)
+  while Hashtbl.mem registry key do
+    Hashtbl.remove registry key
+  done;
+  List.iter (fun v -> set' registry ~key ~value:(marshaller v)) value
 
 type xml_tree =
   | Cdata of string