-(******************************************************************************)
-(* SXSI : XPath evaluator *)
-(* Kim Nguyen (Kim.Nguyen@nicta.com.au) *)
-(* Copyright NICTA 2008 *)
-(* Distributed under the terms of the LGPL (see LICENCE) *)
-(******************************************************************************)
-(* maybe utf8 string... *)
-
-
-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"
-
-let nullt = null_tag ()
-let dummy = nullt
-(* Defined in XMLTree.cpp *)
-let document_node = 0
-let attribute = 1
-let pcdata = 2
-let attribute_data= 3
-let document_node_close = 4
-let attribute_close = 5
-let pcdata_close = 6
-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 print ppf t = Format.fprintf ppf "%s" (to_string t)
-(* Check internal invariants *)
-let check t =
- if (t != tag (to_string t))
- then failwith "module Tag: internal check failed"
-
-let dump = print
-