X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftree.ml;h=587e649261b305a0d3d5a7c9aae954eb703a9713;hb=a47ebfed7e88a701a3345be1bda3c25fd81195a3;hp=6bda2925e4e2c8e0859c95c5fc2f06e24be32b21;hpb=a6baedc6c67cb1de0587a779f8bcddf276b0bf4c;p=SXSI%2Fxpathcomp.git

diff --git a/src/tree.ml b/src/tree.ml
index 6bda292..587e649 100644
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -21,6 +21,34 @@ type node = [ `Tree ] Node.t
 type tree
 
 
+external register_tag : tree -> string -> Tag.t = "caml_xml_tree_register_tag"
+
+external tag_name : tree -> Tag.t -> string = "caml_xml_tree_get_tag_name"
+
+let tag t = (); fun s ->
+  match s with
+  | "<$>" -> Tag.pcdata
+  | "<@>" -> Tag.attribute
+  | "" -> Tag.document_node
+  | "<@$>" -> Tag.attribute_data
+  | _ -> register_tag t s
+
+let to_string d = ();
+  fun t ->
+    if t == Tag.pcdata then "<$>"
+    else if t == Tag.attribute_data then "<@$>"
+    else if t == Tag.attribute then "<@>"
+    else if t == Tag.nullt then "<!NIL!>"
+    else tag_name d t
+
+let translate  x = x
+
+let mk_tag_ops t = {
+  Tag.tag = tag t;
+  Tag.to_string = to_string t;
+  Tag.translate = translate
+}
+
 module TreeBuilder =
 struct
   type t
@@ -133,7 +161,7 @@ type t = {
 }
 
 
-
+let tag_operations t = mk_tag_ops t.doc
 (*
 external parse_xml_uri : string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_uri"
 external parse_xml_string :  string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_string"
@@ -493,7 +521,7 @@ let is_node t = t != nil
 let is_root t = t == root
 
 let node_of_t t  =
-  let _ = Tag.init (Obj.magic t) in
+  let _ = Tag.init (mk_tag_ops t) in
   let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in
   let c = Array.map TagS.to_ptset c in
   let n = Array.map TagS.to_ptset n in
@@ -522,8 +550,6 @@ let parse_xml_string str = node_of_t (TreeBuilder.parse_string str)
 
 let size t = tree_size t.doc;;
 
-external pool : tree -> Tag.pool = "%identity"
-
 let magic_string = "SXSI_INDEX"
 let version_string = "3"
 
@@ -615,8 +641,6 @@ let load ?(sample=64) ?(load_text=true) str =
 
 
 
-let tag_pool t = pool t.doc
-
 let equal a b = a == b
 
 let nts = function