type t = int
-type pool
-
-external null_pool : unit -> pool = "caml_xml_tree_nullt"
-external null_tag : unit -> t = "caml_xml_tree_nullt"
-external register_tag : pool -> string -> t = "caml_xml_tree_register_tag"
-external tag_name : pool -> t -> string = "caml_xml_tree_get_tag_name"
-external num_tags : pool -> int = "caml_xml_tree_num_tags"
-let nullt = null_tag ()
+external to_int : t -> int = "%identity"
+type operations = {
+ tag : string -> t;
+ to_string : t -> string;
+ translate : t -> t
+}
+
+type intern = {
+ mutable tag_ : string -> t;
+ mutable to_string_ : t ->string;
+ mutable translate_ : t -> t
+}
+
+
+
+
+
+let dummy_fun =function _ -> failwith "Tag.ml Uninitialized tag structure"
+
+let ops = {
+ tag_ = dummy_fun;
+ to_string_ = dummy_fun;
+ translate_ = dummy_fun
+}
+
+let init p =
+ ops.tag_ <- p.tag;
+ ops.to_string_ <- p.to_string;
+ ops.translate_ <- p.translate
+
+let tag s = ops.tag_ s
+let to_string t = ops.to_string_ t
+let translate s = ops.translate_ s
+
+
+
+
+let nullt = ~-1
let dummy = nullt
(* Defined in XMLTree.cpp *)
let document_node = 0
let attribute_data_close= 7
-let pool = Weak.create 1
-
-let init p = Weak.set pool 0 (Some p)
-
-let get_pool () = match Weak.get pool 0 with
- | Some x -> x
- | None -> failwith "Tag.ml: Uninitialized Document"
-
-let tag s = match s with
- | "<$>" -> pcdata
- | "<@>" -> attribute
- | "" -> document_node
- | "<@$>" -> attribute_data
- | _ -> register_tag (get_pool()) s
-
let compare = (-)
let equal = (==)
let hash x = x
-
-let to_string t =
- if t == pcdata then "<$>"
- else if t == attribute_data then "<@$>"
- else if t == attribute then "<@>"
- else if t == nullt then "<!NIL!>"
- else tag_name (get_pool()) t
-
+(*
let dump_tags () =
Format.eprintf "Tags are:\n";
let doc = get_pool() in
for i = 0 to ntags - 1 do
Format.eprintf "%i, -><%s/>\n%!" i (to_string i)
done
-
+*)
let print ppf t = Format.fprintf ppf "%s" (to_string t)
let dump = print
+
+
+
+
+
+
+
+
+
+
+(* To move *)
+