Sophie

Sophie

distrib > Mageia > 1 > i586 > media > core-updates-src > by-pkgid > db82867670b82f75aa7e0fd7c801a0bf > files > 2

ocaml-xml-light-2.2-18.1.mga1.src.rpm

Index: xml-light/dtd.ml
===================================================================
--- xml-light/dtd.ml
+++ xml-light/dtd.ml	2012-09-01 11:56:17.000000000 +0100
@@ -93,16 +93,18 @@
 
 type dtd = dtd_item list
 
-type ('a,'b) hash = ('a,'b) Hashtbl.t
+module StringMap = Map.Make(String)
+
+type 'a map = 'a StringMap.t ref
 
 type checked = {
-	c_elements : (string,dtd_element_type) hash;
-	c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
+	c_elements : dtd_element_type map;
+	c_attribs : (dtd_attr_type * dtd_attr_default) map map;
 }
 
 type dtd_state = {
-	elements : (string,dtd_element_type) hash;
-	attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
+	elements : dtd_element_type map;
+  attribs : (dtd_attr_type * dtd_attr_default) map map;
 	mutable current : dtd_element_type;
 	mutable curtag : string;
 	state : (string * dtd_element_type) Stack.t;
@@ -113,7 +115,21 @@
 let _raises e =
 	file_not_found := e
 
-let empty_hash = Hashtbl.create 0
+let create_map() = ref StringMap.empty
+
+let empty_map = create_map()
+
+let find_map m k = StringMap.find k (!m)
+
+let set_map m k v = m := StringMap.add k v (!m)
+
+let unset_map m k = m := StringMap.remove k (!m)
+
+let iter_map f m = StringMap.iter f (!m)
+
+let fold_map f m = StringMap.fold f (!m)
+
+let mem_map m k = StringMap.mem k (!m)
 
 let pos source =
 	let line, lstart, min, max = Xml_lexer.pos source in
@@ -158,45 +174,45 @@
 			raise e
 
 let check dtd =
-	let attribs = Hashtbl.create 0 in
-	let hdone = Hashtbl.create 0 in
-	let htodo = Hashtbl.create 0 in
+	let attribs = create_map() in
+	let hdone = create_map() in
+	let htodo = create_map() in
 	let ftodo tag from =
 		try
-			ignore(Hashtbl.find hdone tag);
+			ignore(find_map hdone tag);
 		with
 			Not_found ->
 				try
-					match Hashtbl.find htodo tag with
-					| None -> Hashtbl.replace htodo tag from
+					match find_map htodo tag with
+					| None -> set_map htodo tag from
 					| Some _ -> ()
 				with
 					Not_found ->
-						Hashtbl.add htodo tag from
+						set_map htodo tag from
 	in
 	let fdone tag edata =
 		try 
-			ignore(Hashtbl.find hdone tag);
+			ignore(find_map hdone tag);
 			raise (Check_error (ElementDefinedTwice tag));
 		with
 			Not_found ->
-				Hashtbl.remove htodo tag;
-				Hashtbl.add hdone tag edata
+				unset_map htodo tag;
+				set_map hdone tag edata
 	in
 	let fattrib tag aname adata =
 		let h = (try
-				Hashtbl.find attribs tag
+				find_map attribs tag
 			with
 				Not_found ->
-					let h = Hashtbl.create 1 in
-					Hashtbl.add attribs tag h;
+				  let h = create_map () in
+					set_map attribs tag h;
 					h) in
 		try
-			ignore(Hashtbl.find h aname);
+			ignore(find_map h aname);
 			raise (Check_error (AttributeDefinedTwice (tag,aname)));
 		with
 			Not_found ->
-				Hashtbl.add h aname adata
+				set_map h aname adata
 	in
 	let check_item = function
 		| DTDAttribute (tag,aname,atype,adef) ->
@@ -229,7 +245,7 @@
 			check_type etype
 	in
 	List.iter check_item dtd;
-	Hashtbl.iter (fun t from ->
+	iter_map (fun t from ->
 		match from with
 		| None -> raise (Check_error (ElementNotDeclared t))
 		| Some tag -> raise (Check_error (ElementReferenced (t,tag)))
@@ -248,7 +264,7 @@
 		curtag = "_root";
 	} in
 	try
-		ignore(Hashtbl.find d.elements (String.uppercase root));
+		ignore(find_map d.elements (String.uppercase root));
 		d
 	with
 		Not_found -> raise (Check_error (ElementNotDeclared root))
@@ -365,7 +381,7 @@
 
 let check_attrib ahash (aname,_) =
 	try
-		ignore(Hashtbl.find ahash aname);
+		ignore(find_map ahash aname);
 	with
 		Not_found -> raise (Prove_error (UnexpectedAttribute aname))
 
@@ -378,12 +394,12 @@
 		let uattr = List.map (fun (aname,aval) -> String.uppercase aname , aval) attr in
 		prove_child dtd (Some utag);
 		Stack.push (dtd.curtag,dtd.current) dtd.state;
-		let elt = (try Hashtbl.find dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
-		let ahash = (try Hashtbl.find dtd.attribs utag with Not_found -> empty_hash) in
+		let elt = (try find_map dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
+		let ahash = (try find_map dtd.attribs utag with Not_found -> empty_map) in
 		dtd.curtag <- tag;
 		dtd.current <- elt;
 		List.iter (check_attrib ahash) uattr;
-		let attr = Hashtbl.fold (prove_attrib dtd uattr) ahash [] in
+		let attr = fold_map (prove_attrib dtd uattr) ahash [] in
 		let childs = ref (List.map (do_prove dtd) childs) in
 		(match dtd.current with
 		| DTDAny
@@ -505,4 +521,4 @@
 		sprintf "<!ELEMENT %s %s>" tag (etype_to_string etype)
 
 ;;
-to_string_ref := to_string
\ No newline at end of file
+to_string_ref := to_string