]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/registry/helm_registry.ml
packaging cleanup: get rid of ancient debhelpers, use dh_install
[helm.git] / helm / ocaml / registry / helm_registry.ml
index 501f689d83f3edf7f2aca9b6a63162ada86d9167..8ee95ca30b646706e54c602188fed6236c5d4c55 100644 (file)
@@ -62,7 +62,6 @@ exception Key_not_found of string
 exception Cyclic_definition of string
 exception Type_error of string (* expected type, value, msg *)
 exception Parse_error of string * int * int * string  (* file, line, col, msg *)
-exception Invalid_value of (string * string) * string (* key, value, descr *)
 
   (* root XML tag: used by save_to, ignored by load_from *)
 let root_tag = "helm_registry"
@@ -195,6 +194,12 @@ let get_list registry unmarshaller key =
     List.map unmarshaller (get registry key)
   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")
+
 let set_list registry marshaller ~key ~value =
   List.iter (fun v -> set registry ~key ~value:(marshaller v)) value
 
@@ -237,9 +242,9 @@ let xml_tree_of_registry registry =
     | _ -> assert false
   in
   Hashtbl.fold
-    (fun k v tree -> add_key ("helm_registry" :: (Str.split dot_RE k)) v tree)
+    (fun k v tree -> add_key ((Str.split dot_RE k)) v tree)
     registry
-    (Element ("helm_registry", [], []))
+    (Element (root_tag, [], []))
 
 let rec stream_of_xml_tree = function
   | Cdata s -> Xml.xml_cdata s
@@ -389,6 +394,7 @@ let get_typed unmarshaller = get_typed default_registry unmarshaller
 let get_opt unmarshaller = get_opt default_registry unmarshaller
 let get_opt_default unmarshaller = get_opt_default default_registry unmarshaller
 let get_list unmarshaller = get_list default_registry unmarshaller
+let get_pair unmarshaller = get_pair default_registry unmarshaller
 let set_typed marshaller = set_typed default_registry marshaller
 let set_opt unmarshaller = set_opt default_registry unmarshaller
 let set_list marshaller = set_list default_registry marshaller