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