Commit before changing Tree.ml interface
authorkim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Thu, 30 Apr 2009 14:24:47 +0000 (14:24 +0000)
committerkim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Thu, 30 Apr 2009 14:24:47 +0000 (14:24 +0000)
git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@365 3cdefd35-fc62-479d-8e8d-bae585ffb9ca

16 files changed:
Makefile
OCamlDriver.cpp
SXSIStorageInterface.cpp
SXSIStorageInterface.h
XMLDocShredder.cpp
ata.ml
debug.ml
hlist.ml
hlist.mli
html_header.ml [deleted file]
html_trace.ml [new file with mode: 0644]
tag.ml
tag.mli
tests/test.xml
tree.ml
tree.mli

index 7b89c53..afa1e3b 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -53,9 +53,9 @@ endif
 
 ifeq ($(PROFILE), true)
 PROFILE_FLAGS = -p 
-SYNT_PROF = $(SYNT_DEBUG) -ppopt -DPROFILE
+SYNT_PROF = -ppopt -DPROFILE
 endif
-
+SYNT_FLAGS = $(SYNT_DEBUG) $(SYNT_PROF)
 OPT_FLAGS = $(DEBUG_FLAGS) $(PROFILE_FLAGS) -nodynlink
 
 OCAMLOPT = ocamlopt -cc "$(CXX)" $(OPT_FLAGS) -ccopt -O3 -ccopt -std=c++0x -noassert -inline $(INLINE)
@@ -67,7 +67,7 @@ OCAMLDEP = ocamldep
 #Ugly but seems difficult with a makefile
 
 LINK=$(OCAMLOPT) -linkpkg `ocamlc -version | grep -q "3.11.0" && echo dynlink.cmxa` camlp4lib.cmxa
-SYNTAX= -syntax camlp4o $(PPINCLUDES) -ppopt pa_macro.cmo $(SYNT_PROF
+SYNTAX= -syntax camlp4o $(PPINCLUDES) -ppopt pa_macro.cmo $(SYNT_FLAGS
 
 
 
index 78d3e15..5b7e0b6 100644 (file)
@@ -49,6 +49,7 @@ extern "C" {
 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
 #define TEXTCOLLECTION(x)
 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
+#define XMLTREE_ROOT 0
 
 extern "C" {
   static struct custom_operations ops;
@@ -143,7 +144,7 @@ void traversal_rec(XMLTree* tree, treeNode id){
 
 extern "C" CAMLprim value caml_cpp_traversal(value tree){
   CAMLparam1(tree);
-  traversal_rec(XMLTREE(tree),XMLTREE(tree)->Root());
+  traversal_rec(XMLTREE(tree),XMLTREE_ROOT);
   CAMLreturn(Val_unit);
 }
 
@@ -219,7 +220,7 @@ extern "C" CAMLprim value caml_text_collection_unsorted_contains(value tree,valu
 
 extern "C" CAMLprim value caml_xml_tree_root(value tree){
   CAMLparam1(tree);
-  CAMLreturn (Val_int(TREENODEVAL(XMLTREE(tree)->Root())));
+  CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
 }
 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
   CAMLparam1(tree);
@@ -276,6 +277,17 @@ extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
   CAMLreturn(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
 }
 
+extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
+  CAMLparam3(tree,id,tag);
+  CAMLreturn(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
+}
+
+extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
+  CAMLparam3(tree,id,tag);
+  CAMLreturn(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
+}
+
+
 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
   CAMLparam2(tree,id);
   CAMLreturn(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
@@ -397,14 +409,45 @@ extern "C" CAMLprim value caml_int_vector_alloc(value len){
 }
 
 extern "C" CAMLprim value caml_int_vector_set(value vec, value i, value v){
-  CAMLparam3(vec,i,v);
-  
+  CAMLparam3(vec,i,v);  
   ((int*) vec)[Int_val(i)+1] = Int_val(v);
   CAMLreturn (Val_unit);
 }
 
 
 #define VECT(x)  ((int*) (x))
+extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
+  CAMLparam3(tree,node,tags);
+   
+  CAMLreturn (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
+                                                 &(VECT(tags)[1]),
+                                                VECT(tags)[0])));
+}
+extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
+  CAMLparam3(tree,node,tags);
+   
+  CAMLreturn (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
+                                                 &(VECT(tags)[1]),
+                                                 VECT(tags)[0])));
+}
+extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
+  CAMLparam3(tree,node,tags);
+  
+  CAMLreturn (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
+                                                       &(VECT(tags)[1]),
+                                                       VECT(tags)[0])));
+}
+extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
+  CAMLparam4(tree,node,tags,ctx);
+  
+  CAMLreturn (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
+                                                     &(VECT(tags)[1]),
+                                                     VECT(tags)[0],Int_val(ctx))));
+}
+
+
+                       
+/*
 extern "C" CAMLprim value caml_xml_tree_select_below(value tree, value node, value ctags, value dtags){
   CAMLparam4(tree,node,ctags,dtags);
    
@@ -414,8 +457,9 @@ extern "C" CAMLprim value caml_xml_tree_select_below(value tree, value node, val
                                                   VECT(ctags)[0],
                                                   &(VECT(dtags)[1]),
                                                   VECT(dtags)[0]))));                                     
-}
-
+                                                  }
+*/
+/*
 extern "C" CAMLprim value caml_xml_tree_select_next(value tree, value node, value ctags, value ftags,value root){
   CAMLparam5(tree,node,ctags,ftags,root);
   CAMLreturn (Val_int (
@@ -426,7 +470,8 @@ extern "C" CAMLprim value caml_xml_tree_select_next(value tree, value node, valu
                                                  VECT(ftags)[0],
                                                  TREENODEVAL(root)))));
 }
-
+*/
+/*
 extern "C" CAMLprim value caml_xml_tree_select_desc_only(value tree, value node,value dtags){
   CAMLparam3(tree,node,dtags);
    
@@ -453,7 +498,7 @@ extern "C" CAMLprim value caml_xml_tree_select_desc_or_foll_only(value tree, val
                                                  VECT(ftags)[0],
                                                  TREENODEVAL(root)))));
 }
-
+*/
 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
   CAMLparam2(tree,node);
   CAMLlocal1(tuple);
index 88ed42f..0a1a715 100644 (file)
@@ -13,8 +13,9 @@
 
 SXSIStorageInterface::SXSIStorageInterface(int sf,bool iet,bool dtc)
 {
-  tree = new XMLTree();
-  tree->OpenDocument(iet,sf,dtc);
+  tree = NULL;
+  tb = new XMLTreeBuilder();
+  tb ->OpenDocument(iet,sf,dtc);
 }
 
 SXSIStorageInterface::~SXSIStorageInterface()
@@ -24,7 +25,7 @@ SXSIStorageInterface::~SXSIStorageInterface()
 void SXSIStorageInterface::newChild(string name)
 { 
   _new_child++;
-  tree->NewOpenTag((unsigned char*) name.c_str());
+  tb->NewOpenTag((unsigned char*) name.c_str());
 }
 
 
@@ -33,26 +34,26 @@ void SXSIStorageInterface::newText(string text)
 
   if (text.empty()) {
     _new_empty_text++;
-    tree->NewEmptyText();
+    tb->NewEmptyText();
   }
   else {
     _new_text++;
     _length_text += text.size();
-    tree->NewText((unsigned char*) text.c_str());  
+    tb->NewText((unsigned char*) text.c_str());  
   }
 }
 
 
 void SXSIStorageInterface::nodeFinished(string name)
 {  
-  tree->NewClosingTag((unsigned char*) name.c_str());
+  tb->NewClosingTag((unsigned char*) name.c_str());
 
 }            
              
   void SXSIStorageInterface::parsingFinished()
 {
 
-  tree->CloseDocument();
+  tree = tb->CloseDocument();
        
 }
 
index 943a000..bd65594 100644 (file)
@@ -11,6 +11,7 @@
 #define SXSISTORAGEINTERFACE_H_
 
 #include "XMLTree.h"
+#include "XMLTreeBuilder.h"
 #include "StorageInterface.h"
 extern "C" {
 #include <caml/mlvalues.h>
@@ -40,6 +41,7 @@ class SXSIStorageInterface: public StorageInterface
  private:
 
        XMLTree* tree;
+       XMLTreeBuilder* tb;
        int _new_text;
        int _new_empty_text;
        int _new_child;
index c048d2e..1516c9f 100644 (file)
@@ -88,9 +88,6 @@ void XMLDocShredder::processStartElement()
        ustring name = reader_->get_name();
        bool empty = false;
        
-       storageIfc_->newText(buffer); //prevText
-       buffer.erase();
-       
        storageIfc_->newChild(name);
 
        /* We must be really carefull here. calling process attributes moves
@@ -108,8 +105,7 @@ void XMLDocShredder::processStartElement()
 
        
        if (empty){
-           storageIfc_->newText("");  //myText
-           storageIfc_->nodeFinished(name);       
+         storageIfc_->nodeFinished(name);         
        };
 
 
@@ -117,21 +113,19 @@ void XMLDocShredder::processStartElement()
 
 void XMLDocShredder::processEndElement()
 {
-  // tell the storage interface that the current node has been completely processed
-  storageIfc_->newText(buffer); //prevText
-  buffer.erase();
+  // tell the storage interface that the current node has been completely processed  
   storageIfc_->nodeFinished(reader_->get_name());
 }
 
 void XMLDocShredder::processPCDATA()
 {
-       // send the content of this PCDATA node to the storage interface as a text node
-         
-       if (reader_->has_value())
-       {
-         buffer += reader_->get_value();
-       };
-
+  // send the content of this PCDATA node to the storage interface as a text node
+  
+  if (reader_->has_value()){
+    storageIfc_->newChild("<$>");
+    storageIfc_->newText(reader_->get_value());
+    storageIfc_->nodeFinished("<$>");
+  };
 }
 
 void XMLDocShredder::processAttributes()
@@ -139,7 +133,6 @@ void XMLDocShredder::processAttributes()
        reader_->move_to_first_attribute();
                
        string nspaceStr = "xmlns";
-       storageIfc_->newText(""); //prevText
        storageIfc_->newChild("<@>");
        do
        {
@@ -163,22 +156,26 @@ void XMLDocShredder::processAttributes()
                 
                else
                {
-                 storageIfc_->newText(""); //prevText
-                 storageIfc_->newChild(name);
+                 string attname = "<@>"+name;
+                 storageIfc_->newChild(attname);
+                 storageIfc_->newChild("<@$>");
                  storageIfc_->newText(value);
-                 storageIfc_->nodeFinished(name);
+                 storageIfc_->nodeFinished("<@$>");
+                 storageIfc_->nodeFinished(attname);
                }
        }
        while (reader_->move_to_next_attribute());
-       storageIfc_->newText(""); //nextText
        storageIfc_->nodeFinished("<@>");
 }
 
 void XMLDocShredder::processSignificantWhitespace()
 {
-  // each significant whitespace sequence constructs a text node
-  buffer += reader_->get_value();      
-       
+  
+  if (reader_->has_value()){
+    storageIfc_->newChild("<$>");
+    storageIfc_->newText(reader_->get_value());
+    storageIfc_->nodeFinished("<$>");
+  };  
 }
 
 void XMLDocShredder::processStartDocument(const string docName)
@@ -192,7 +189,6 @@ void XMLDocShredder::processEndDocument()
 {
        /* tell the storage interface that document parsing has finished, and structures
         * can now be written to disk. */
-  storageIfc_->newText("");
   storageIfc_->nodeFinished("");
   storageIfc_->parsingFinished();      
 }
@@ -231,10 +227,11 @@ void XMLDocShredder::processCDATASection()
         * model.  Instead, we simply pass the converted text value to the storage interface as 
         * a text node attached to the current context node.
         */
-  
-       ustring value = reader_->get_value();
-       storageIfc_->newText(value);
-       last_text = true;
+  if (reader_->has_value()){
+    storageIfc_->newChild("<$>");
+    storageIfc_->newText(reader_->get_value());
+    storageIfc_->nodeFinished("<$>");
+  };
 
 }
 
diff --git a/ata.ml b/ata.ml
index 79ffe6c..e06ac04 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -525,7 +525,6 @@ THEN
 INCLUDE "html_trace.ml"
              
 END            
-
       let mk_fun f s = D_IGNORE_(register_funname f s,f)
       let mk_app_fun f arg s = let g = f arg in 
        D_IGNORE_(register_funname g ((get_funname f) ^ " " ^ s), g) 
@@ -555,22 +554,22 @@ END
       let choose_jump_down a b c d =
        choose_jump a b c d
          (mk_fun (Tree.mk_nil) "Tree.mk_nil")
-         (mk_fun (Tree.text_below) "Tree.text_below")
-         (mk_fun (fun _ -> Tree.node_child) "[TaggedChild]Tree.node_child") (* !! no tagged_child in Tree.ml *)
-         (mk_fun (fun _ -> Tree.node_child) "[SelectChild]Tree.node_child") (* !! no select_child in Tree.ml *)
+         (mk_fun (Tree.first_child) "Tree.text_below")
+         (mk_fun (Tree.tagged_child) "Tree.tagged_child") 
+         (mk_fun (Tree.select_child) "Tree.select_child") (* !! no select_child in Tree.ml *)
          (mk_fun (Tree.tagged_desc) "Tree.tagged_desc")
-         (mk_fun (fun _ -> Tree.node_child ) "[SelectDesc]Tree.node_child") (* !! no select_desc *)
-         (mk_fun (Tree.node_child) "Tree.node_child")
+         (mk_fun (Tree.select_desc) "Tree.select_desc") (* !! no select_desc *)
+         (mk_fun (Tree.first_child) "Tree.first_child")
 
       let choose_jump_next a b c d = 
        choose_jump a b c d
          (mk_fun (fun t _ -> Tree.mk_nil t) "Tree.mk_nil2")
-         (mk_fun (Tree.text_next) "Tree.text_next")
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[TaggedSibling]Tree.node_sibling_ctx")(* !! no tagged_sibling in Tree.ml *)
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectSibling]Tree.node_sibling_ctx")(* !! no select_sibling in Tree.ml *)
+         (mk_fun (Tree.next_sibling_ctx) "Tree.text_next")
+         (mk_fun (Tree.tagged_sibling_ctx) "Tree.tagged_sibling_ctx")(* !! no tagged_sibling in Tree.ml *)
+         (mk_fun (Tree.select_sibling_ctx) "Tree.select_sibling_ctx")(* !! no select_sibling in Tree.ml *)
          (mk_fun (Tree.tagged_foll_ctx) "Tree.tagged_foll_ctx")
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectFoll]Tree.node_sibling_ctx")(* !! no select_foll *)
-         (mk_fun (Tree.node_sibling_ctx) "Tree.node_sibling_ctx")        
+         (mk_fun (Tree.select_foll_ctx) "Tree.select_foll_ctx")(* !! no select_foll *)
+         (mk_fun (Tree.next_sibling_ctx) "Tree.node_sibling_ctx")        
          
 
          module SetTagKey =
@@ -621,7 +620,7 @@ END
        in
        let null_result() = (pempty,Array.make slot_size RS.empty) in
 
-       let rec loop t slist ctx = 
+       let rec loop t slist ctx =
          if Tree.is_nil t then null_result() else get_trans t slist (Tree.tag t) ctx
 
        and loop_tag tag t slist ctx =
@@ -673,7 +672,8 @@ END
                    let empty_res = null_result() in
                    let cont = 
                      match f_kind,n_kind with
-                       | `NIL,`NIL -> (fun _ _ -> null_result())
+                       | `NIL,`NIL -> 
+                           (fun _ _ -> eval_fold2_slist fl_list t empty_res empty_res )
                        |  _,`NIL -> (
                             match f_kind with
                               |`TAG(tag) -> 
@@ -682,12 +682,12 @@ END
                               | `ANY -> 
                                   (fun t _ -> eval_fold2_slist fl_list t empty_res
                                      (loop (first t) llist t))
-                              | _ -> assert false)
+                              | _ -> assert false)                          
 
                        | `NIL,_ -> (
                            match n_kind with
                              |`TAG(tag) ->  
-                                (fun t ctx ->  eval_fold2_slist fl_list t 
+                                (fun t ctx -> eval_fold2_slist fl_list t 
                                    (loop_tag tag (next t ctx) rlist ctx) empty_res)
 
                              | `ANY -> 
@@ -717,6 +717,12 @@ END
                                 (loop (next t ctx) rlist ctx)
                                 (loop (first t) llist t) )
                        | _ -> assert false
+                   in
+                   let cont = D_IF_( (fun t ctx ->
+                                        let a,b = cont t ctx in
+                                          register_trace t (slist,a,fl_list,first,next,ctx);
+                                          (a,b)
+                                     ) ,cont) 
                    in
                      (CachedTransTable.add td_trans (tag,slist) cont;cont)
          in cont t ctx
@@ -934,7 +940,7 @@ END
              | `TAG (tag) -> 
                  (*Tree.tagged_lowest t tag, fun tree -> Tree.tagged_next tree tag*)
                  (Tree.tagged_desc tag t, fun tree -> Tree.tagged_foll_ctx tag tree t)
-             | `CONTAINS(_) -> (Tree.text_below t,fun tree -> Tree.text_next tree t)
+             | `CONTAINS(_) -> (Tree.first_child t,fun tree -> Tree.next_sibling_ctx tree t)
              | _ -> assert false
          in
          let tree2 = jump_fun tree1 in
index 39b4fcf..7ae4e75 100644 (file)
--- a/debug.ml
+++ b/debug.ml
@@ -18,10 +18,12 @@ THEN
 module Loc = Camlp4.PreCast.Loc
 
 DEFINE D_IGNORE_(e1,e2) = (let () = e1 in ();e2)
+DEFINE D_IF_(e1,e2) = e1
 
 ELSE
 DEFINE D_IGNORE_(e1,e2) = (e2)
 
+DEFINE D_IF_(e1,e2) = e2
 
 END (* IFDEF DEBUG *)
 
index cd3c90d..4b83668 100644 (file)
--- a/hlist.ml
+++ b/hlist.ml
@@ -16,6 +16,7 @@ module type S = sig
   val iter : (elt -> 'a) -> t -> unit
   val rev : t -> t
   val rev_map : (elt -> elt) -> t -> t
+  val length : t -> int
 end
 
 module Make ( H : Hcons.S ) : S with type elt = H.t =
@@ -78,5 +79,5 @@ struct
        
   let rev l = fold cons l nil
   let rev_map f l = fold (fun x acc -> cons (f x) acc) l nil
-         
+  let length l = fold (fun _ c -> c+1) l 0 
 end
index 15bafe5..7796833 100644 (file)
--- a/hlist.mli
+++ b/hlist.mli
@@ -15,6 +15,7 @@ module type S = sig
   val iter : (elt -> 'a) -> t -> unit
   val rev : t -> t
   val rev_map : (elt -> elt) -> t -> t
+  val length : t -> int
 end
 
 module Make (H : Hcons.S) : S with type elt = H.t
diff --git a/html_header.ml b/html_header.ml
deleted file mode 100644 (file)
index f2b1a8e..0000000
+++ /dev/null
@@ -1,211 +0,0 @@
-let html_header  = format_of_string
-           "<!DOCTYPE html 
-     PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
-     \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
-<html xmlns=\"http://www.w3.org/1999/xhtml\" >
-
-<head>
-<meta http-equiv=\"content-type\" content=\"text/html;
-charset=utf-8\" />
-<style type=\"text/css\" media=\"all\">
-
- div { 
- display:inline;
- position: relative;
-}
-
-  div[class=\"touched\"] { 
-  color: #008;
-  text-decoration: none;
-  }
-  div[class=\"touched_text\"] { 
-  color: #fff;
-  background-color: #00a;  
-  white-space : pre;
-  display:inline;
-  text-decoration:none;
-  }
-
-  div[class=\"selected\"] { 
-  color: #00f;
-  background: #ddf;
-  }
-  div[class=\"selected_text\"] { 
-  color: #fff;
-  background-color: #00f;
-  white-space : pre;
-  }
-
-  div[class=\"skipped_text\"] {
-   white-space : pre;
-   display:inline;
-   color: #555;
-  }
-
-  
-  div[class=\"skipped\"] { 
-  color: #555;
-   display:inline;
-  }
-  
-  div:hover[class=\"skipped\"] { 
-  color: #555;
-  }
-    
-
-  div span {
-  display: none;
-  }
-
-  div[id=\"tooltipzone\"] span {
-  display: block;
-  text-decoration: none;
-  font-family: monospace;
-  font-size: 16px;
-  padding:10px;
-  overflow:auto;
-  height: %ipx;
-  background: #ee4;
-  color: #000;
-  white-space: pre;
-  }
-  
-  div:hover {
-  display: inline;
-  }
-
-
-  div[class=\"header\"]{
-  display:block;
-  position:fixed;
-  top: 0px;
-  width:40%%;
-  height: %ipx;
-  overflow: auto;
-  background-color: white;
-  z-index:20;
-  white-space : pre;
-  font-family: monospace;
-  font-size : 16px;
-  padding: 0px;
-  }
-
-  div[class=\"document\"] {
-  position:fixed;
-  top: %ipx;
-  left: 10px;
-  right: 0px;
-  bottom: 0px;
-  overflow: auto;
-  font-family: monospace;
-  font-size:14px;  
-  white-space: nowrap;
-  }
-
-  div[class=\"yellow\"] {
-  display: block;
-  position: fixed;
-  top: 0px;
-  overflow:auto;
-  left:40%%;
-  right:0px;
-  height: %ipx;
-  padding: 0%%;
-  background: #ee4;
-  color: #000;
-  white-space: pre;
-  }
-</style>
-</head>
-<body>
-<script type=\"text/javascript\">
-function ShowPopup(span)
-{
- ttz = document.getElementById('tooltipzone');  
- children = ttz.childNodes;
- if (children.length == 1){
-   id = children[0].id;
-   newid = \"div\" + id.substring(2);
-   div = document.getElementById(newid);
-   div.appendChild(children[0]);
- };
- ttz.appendChild(span); 
-};
-
-
-</script>
-"
-let html_footer = "</div> <!-- document -->
-</body>
-</html>"
-      let h_trace = Hashtbl.create 4096
-      let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
-
-
-      let output_trace a t file results =
-       let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.phi 0) in
-       let max_tt = ref 0 in
-       let outc = open_out file in
-       let outf = Format.formatter_of_out_channel outc in
-       let strf = Format.str_formatter in
-       let pr_str x = Format.fprintf strf x in
-       let pr_out x = Format.fprintf outf x in
-         let rec loop t = 
-           if not (Tree.is_nil t) then
-             let tooltip,selected = try 
-               let (inconf,outconf,leftres,rightres,trans) = Hashtbl.find h_trace (Tree.id t) in
-               let selected = IntSet.mem (Tree.id t) results in
-                 pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\nEntered with configuration:\n" 
-                 (Tree.id t) (Tree.id t)  (Tag.to_string (Tree.tag t)) (Tree.dump_node t);
-                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) inconf;
-                 pr_str "%s" "\nLeft with configuration:\n";
-                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) outconf;
-                 pr_str "%s" "\nAccept states for left child:\n";
-                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) leftres;
-                 pr_str "%s" "\nAccept states for right child:\n";
-                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) rightres;              
-                 pr_str "%s" "\nTriggered transitions:\n";
-                 pr_str "%s" "<table><tr valign=\"top\">";
-                 List.iter (fun fl ->
-                              pr_str "%s" "<td>";pr_frmlst strf fl;pr_str "</td>";
-                              max_tt := max !max_tt (form_list_length fl);
-                           ) trans;
-                 pr_str "%s" "</td></table>\n";
-                 pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
-                 Format.flush_str_formatter(),selected
-             with
-                 Not_found -> "",false
-             in
-             let tag = Tree.tag t in
-             let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
-               (if tag == Tag.pcdata then "_text" else"")
-             in
-               if tag == Tag.pcdata then 
-                 pr_out "<div class=\"%s\">%s%s</div>"div_class (Tree.get_text t) tooltip
-               else begin
-                 if (Tree.is_nil (Tree.first_child t))
-                 then
-                   pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s/&gt;%s</div>" 
-                      div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip
-                 else begin
-                    pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s&gt;%s</div>" 
-                      div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip;
-                   loop (Tree.first_child t);
-                   pr_out "<div class=\"%s\"> &lt;/%s&gt;</div>" div_class (Tag.to_string tag);
-                 end;
-               end;
-               loop (Tree.next_sibling t);
-         in
-         let max_tt = 25*(!max_tt + 12)+20 in
-         let height = max max_tt (25*h_auto) in
-           pr_out html_header height height height height;
-           pr_out "%s" "<div class=\"header\">";
-           dump outf a;
-           pr_out "%s"  "</div><div class=\"yellow\" id=\"tooltipzone\"></div>";
-           pr_out "%s" "<div class=\"document\">";
-           loop t;
-           pr_out "%s" html_footer;
-           pr_out "%!";
-           close_out outc
diff --git a/html_trace.ml b/html_trace.ml
new file mode 100644 (file)
index 0000000..c5ed980
--- /dev/null
@@ -0,0 +1,268 @@
+let html_header  = format_of_string
+           "<!DOCTYPE html 
+     PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
+     \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\" >
+
+<head>
+<meta http-equiv=\"content-type\" content=\"text/html;
+charset=utf-8\" />
+<style type=\"text/css\" media=\"all\">
+
+ hr {
+ height : 100px;
+ width : 5px;
+}
+ div { 
+ display:inline;
+ position: relative;
+}
+
+  a { 
+  text-decoration:none;
+  }
+
+  span a { text-decoration:underline; }
+
+
+  div[class=\"touched\"] { 
+  color: #008;
+  text-decoration: none;
+  }
+
+  div[class=\"touched_text\"] { 
+  color: #fff;
+  background-color: #00a;  
+  white-space : pre;
+  display:inline;
+  text-decoration:none;
+  }
+
+  div[class=\"selected\"] { 
+  color: #00f;
+  background: #ddf;
+  text-decoration:none;
+  }
+  div[class=\"selected_text\"] { 
+  color: #fff;
+  background-color: #00f;
+  white-space : pre;
+  text-decoration:none;
+  }
+
+  div[class=\"skipped_text\"] {
+   white-space : pre;
+   display:inline;
+   color: #555;
+  }
+
+  
+  div[class=\"skipped\"] { 
+  color: #555;
+  display:inline;
+  }
+  
+  div:hover[class=\"skipped\"] { 
+  color: #555;
+  }
+    
+
+  div span {
+  display: none;
+  }
+
+  div[id=\"tooltipzone\"] span {
+  display: block;
+  text-decoration: none;
+  font-family: monospace;
+  font-size: 16px;
+  padding:10px;
+  overflow:none;
+  height: %ipx;
+  background: #ee4;
+  color: #000;
+  white-space: pre;
+  }
+  
+  div:hover {
+  display: inline;
+  }
+  
+  div[class=\"header\"]{
+  display:block;
+  position:fixed;
+  top: 0px;
+  width:40%%;
+  height: %ipx;
+  overflow: auto;
+  background-color: white;
+  z-index:20;
+  white-space : pre;
+  font-family: monospace;
+  font-size : 16px;
+  padding: 0px;
+  }
+
+  div[class=\"document\"] {
+  position:fixed;
+  top: %ipx;
+  left: 10px;
+  right: 0px;
+  bottom: 0px;
+  overflow: auto;
+  font-family: monospace;
+  font-size:14px;  
+  white-space: nowrap;
+  }
+
+  div[class=\"yellow\"] {
+  display: block;
+  position: fixed;
+  top: 0px;
+  overflow:auto;
+  left:40%%;
+  right:0px;
+  height: %ipx;
+  padding: 0%%;
+  background: #ee4;
+  color: #000;
+  white-space: pre;
+  }
+</style>
+</head>
+<body>
+<script type=\"text/javascript\">
+function ShowPopup(span)
+{
+ if (span != null){
+ ttz = document.getElementById('tooltipzone');  
+ children = ttz.childNodes;
+ if (children.length == 1){
+   id = children[0].id;
+   newid = \"div\" + id.substring(2);
+   div = document.getElementById(newid);
+   div.appendChild(children[0]);
+ };
+ ttz.appendChild(span); 
+}
+};
+
+
+</script>
+"
+let html_footer = "</div> <!-- document -->
+</body>
+</html>"
+let h_trace = Hashtbl.create 4096
+let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
+let h_fname = Hashtbl.create 401
+
+let register_funname f s = Hashtbl.add h_fname (Hashtbl.hash  f) s
+let get_funname f = try Hashtbl.find h_fname (Hashtbl.hash  f) with _ -> "[anon_fun]"
+let tag_to_str tag = 
+  let s = Tag.to_string tag in
+  let num =ref 0 in
+    for i=0 to (String.length s)-1 do
+      match s.[i] with
+       | '<' | '>' -> incr num
+       | _ -> ()
+    done;
+    if !num == 0 then s
+    else
+      let j = ref 0 in
+      let ns = String.create ((String.length s)+3 * !num) in
+       for i=0 to (String.length s)-1 do
+         match s.[i] with
+           | '<' | '>' as x -> 
+               ns.[!j] <- '&';
+               ns.[!j+1] <- (if x == '>' then 'g' else 'l') ;
+               ns.[!j+2] <- 't';
+               ns.[!j+3] <- ';'; 
+               j:= !j+4
+           | _ -> ns.[!j] <- s.[i]; incr j
+       done;
+       ns
+           
+
+let output_trace a t file results =
+  let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.trans 0) in
+  let max_tt = ref 0 in
+  let outc = open_out file in
+  let outf = Format.formatter_of_out_channel outc in
+  let strf = Format.str_formatter in
+  let pr_str x = Format.fprintf strf x in
+  let pr_out x = Format.fprintf outf x in
+  let rec loop t = 
+    if not (Tree.is_nil t) then
+      let id = Tree.id t in
+      let tag = Tree.tag t in
+      let tooltip,selected = try 
+       let (inconf,outconf,trans,first_fun,next_fun,ctx) = Hashtbl.find h_trace id in
+       let selected = IntSet.mem id results in
+         pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\n" 
+           id id  (tag_to_str tag) (Tree.dump_node t);
+         
+         pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
+           (Tree.id ctx) (tag_to_str (Tree.tag ctx)) (Tree.dump_node ctx);
+         pr_str "%s" "\nEntered with configuration:\n";
+         SList.iter (fun s -> StateSet.print strf s) inconf;
+         pr_str "%s" "\nLeft with configuration:\n";
+         SList.iter (fun s -> StateSet.print strf s) outconf;
+         (let ft = first_fun t in
+            pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\" >Left successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
+              (Tree.id ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag ft)) (Tree.dump_node ft);
+            pr_str "Moving with : %s (tree=%i)\n" (get_funname first_fun) id;
+         );
+         (let nt = next_fun t ctx in
+            pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">Right successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
+              (Tree.id nt) (Tree.id nt) (Tree.id nt) (tag_to_str (Tree.tag nt)) (Tree.dump_node nt);
+            pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname first_fun) id (Tree.id ctx);
+         );
+         pr_str "%s" "\nTriggered transitions:\n";
+         pr_str "%s" "<table><tr valign=\"top\">";
+         List.iter (fun fl ->
+                      pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
+                      max_tt := max !max_tt (Formlist.length fl);
+                   ) trans;
+         pr_str "%s" "</td></table>\n";
+         pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
+         Format.flush_str_formatter(),selected
+      with
+         Not_found -> "",false
+      in
+      let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
+       (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"")
+      in
+       if tag == Tag.pcdata || tag== Tag.attribute_data then 
+         pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (Tree.get_text t) tooltip
+       else begin
+         if (Tree.is_nil (Tree.first_child t))
+         then
+           pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s/&gt;%s</div>" 
+             div_class id id id (tag_to_str tag) tooltip
+         else begin
+            pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s&gt;%s</div>" 
+             div_class id id id (tag_to_str tag) tooltip;
+           loop (Tree.first_child t);
+           if (tooltip="") then
+             pr_out "<div class=\"%s\">&lt;/%s&gt;</div>" div_class (tag_to_str tag)
+           else
+             pr_out "<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><div class=\"%s\">&lt;/%s&gt;</div></a>" id id  div_class (tag_to_str tag);
+         end;
+       end;
+       loop (Tree.next_sibling t);
+  in
+  let max_tt = 25*(!max_tt + 15)+20 in
+  let height = max max_tt (25*h_auto) in
+    pr_out html_header height height height height;
+    pr_out "%s" "<div class=\"header\">";
+    pr_out "query: %s\n" a.query_string;
+    dump outf a;
+    pr_out "%s"  "</div><hr  /><div class=\"yellow\" id=\"tooltipzone\"></div>";
+    pr_out "%s" "<div class=\"document\">";
+    loop t;
+    pr_out "%s" html_footer;
+    pr_out "%!";
+    close_out outc
+             
diff --git a/tag.ml b/tag.ml
index c500dab..f9c0275 100644 (file)
--- a/tag.ml
+++ b/tag.ml
@@ -17,8 +17,11 @@ external tag_name : pool -> t -> string = "caml_xml_tree_tag_name"
 
 let nullt = null_tag ()   
 (* Defined in XMLTree.cpp *)
-let pcdata = 1
-let attribute = 0 
+let document_node = 0
+let attribute = 1
+let pcdata = 2
+let attribute_data= 3
+
 
 let pool = Weak.create 1
 
@@ -31,6 +34,8 @@ let get_pool () =  match Weak.get pool 0 with
 let tag s = match s with
   | "<$>" -> pcdata
   | "<@>" -> attribute
+  | "" -> document_node
+  | "<@$>" -> attribute_data
   | _ -> register_tag (get_pool()) s
 
 let compare = (-)
@@ -41,6 +46,7 @@ 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
diff --git a/tag.mli b/tag.mli
index b5e0ad2..bc3ee55 100644 (file)
--- a/tag.mli
+++ b/tag.mli
@@ -1,8 +1,13 @@
 type t = int
 type pool 
 val tag : string -> t
-val pcdata : t
+
+val document_node : t
 val attribute : t
+val pcdata : t
+val attribute_data : t
+
+
 val init : pool -> unit
 val to_string : t -> string
 val compare : t -> t -> int
index f1dfe41..4c57628 100644 (file)
@@ -1,7 +1,4 @@
 <?xml version="1.0"?>
-<a>
-  <d><e/><b> <c>  </c> </b></d>
-  <d><b></b><a/></d>
-  <d><b></b></d>
-  <d><e/><b><c/></b></d>
-</a>
+<a>1<b id="4" />2<b>
+
+</b>3</a>
diff --git a/tree.ml b/tree.ml
index 1ed56b2..e3e8fe2 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -41,7 +41,7 @@ external text_count_contains : tree -> string -> int = "caml_text_collection_cou
 external text_count : tree -> string -> int = "caml_text_collection_count" 
 external text_contains : tree -> string -> [`Text ] node array = "caml_text_collection_contains" 
 external text_unsorted_contains : tree -> string -> unit = "caml_text_collection_unsorted_contains"
-external get_cached_text : tree -> [`Text] node -> string = "caml_text_collection_get_cached_text"
+external text_get_cached_text : tree -> [`Text] node -> string = "caml_text_collection_get_cached_text"
 
 
 external tree_serialize : tree -> string -> unit = "caml_xml_tree_serialize"
@@ -56,7 +56,10 @@ external tree_parent : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_par
 external tree_parent_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_parent_doc" 
 external tree_prev_doc : tree -> [`Text ] node -> [`Tree ] node = "caml_xml_tree_prev_doc" 
 external tree_first_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_first_child" 
+external tree_tagged_child : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_child" 
 external tree_next_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_next_sibling" 
+external tree_tagged_sibling : tree -> [`Tree] node -> Tag.t -> [`Tree] node = "caml_xml_tree_tagged_sibling" 
+
 external tree_prev_sibling : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_prev_sibling" 
 external tree_is_leaf : tree -> [`Tree] node -> bool = "caml_xml_tree_is_leaf" 
 external tree_last_child : tree -> [`Tree] node -> [`Tree] node = "caml_xml_tree_last_child"
@@ -76,10 +79,10 @@ external tree_doc_ids : tree -> [`Tree ] node -> [`Text ] node * [`Text ] node =
 
 let text_size tree = int_of_node (snd ( tree_doc_ids tree (Obj.magic 0) ))
 
-let get_cached_text t x =
+let text_get_cached_text t x =
   if x == -1 then ""
   else 
-     get_cached_text t x
+     text_get_cached_text t x
 
 
 external tree_text_xml_id : tree -> [`Text ] node -> int = "caml_xml_tree_text_xml_id" 
@@ -88,24 +91,41 @@ external tree_is_ancestor : tree -> [`Tree ] node -> [`Tree ] node -> bool = "ca
 external tree_tagged_desc : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node = "caml_xml_tree_tagged_desc" 
 external tree_tagged_foll_below : tree -> [`Tree ] node -> Tag.t -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_tagged_foll_below" 
 external tree_subtree_tags : tree -> [`Tree ] node -> Tag.t -> int = "caml_xml_tree_subtree_tags" 
-(*
-external tree_select_below : tree -> [`Tree ] node -> Ptset.int_vector -> Ptset.int_vector -> [`Tree ] node = "caml_xml_tree_select_below" 
-external tree_select_desc_only : tree -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node = "caml_xml_tree_select_desc_only" 
-external tree_select_next : tree -> [`Tree ] node -> Ptset.int_vector -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_select_next" 
-external tree_select_foll_only : tree -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_select_foll_only" 
-external tree_select_desc_or_foll_only : tree -> [`Tree ] node -> Ptset.int_vector -> [`Tree ] node -> [`Tree ] node = "caml_xml_tree_select_foll_only" *)
-  
-type descr = 
-  | Nil 
-  | Node of [`Tree] node
-  | Text of [`Text] node * [`Tree] node
+
+
+
+type int_vector
+external int_vector_alloc : int -> int_vector = "caml_int_vector_alloc"
+external int_vector_length : int_vector -> int = "caml_int_vector_length"
+external int_vector_set : int_vector -> int -> int -> unit = "caml_int_vector_set"
+
+external tree_select_child : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_child"
+external tree_select_foll_sibling : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_foll_sibling"
+external tree_select_desc : tree -> [`Tree ] node -> int_vector -> [`Tree] node = "caml_xml_tree_select_desc"
+external tree_select_foll_below : tree -> [`Tree ] node -> int_vector -> [`Tree] node -> [`Tree] node = "caml_xml_tree_select_foll_below"
+
+
+module HPtset = Hashtbl.Make(Ptset.Int)
+
+let vector_htbl = HPtset.create MED_H_SIZE
+
+let ptset_to_vector s =
+  try 
+    HPtset.find vector_htbl s
+  with
+      Not_found ->
+       let v = int_vector_alloc (Ptset.Int.cardinal s) in
+       let _ = Ptset.Int.fold (fun e i -> int_vector_set v i e;i+1) s 0 in
+         HPtset.add vector_htbl s v; v
+
       
 type t = { doc : tree;           
-          node : descr;
+          node : [`Tree] node;
           ttable : (Tag.t,(Ptset.Int.t*Ptset.Int.t)) Hashtbl.t;
         }
 
 let text_size t = text_size t.doc
+
 module MemUnion = Hashtbl.Make (struct 
       type t = Ptset.Int.t*Ptset.Int.t
       let equal (x,y) (z,t) = (Ptset.Int.equal x z)&&(Ptset.Int.equal y t)
@@ -137,14 +157,13 @@ let collect_tags tree =
          Hashtbl.add h_add k r;r
   in
   let h = Hashtbl.create BIG_H_SIZE in
-  let sing = Ptset.Int.singleton Tag.pcdata in    
   let update t sb sa =
     let sbelow,safter = 
       try
        Hashtbl.find h t 
       with
        | Not_found -> 
-           (sing,sing)
+           (Ptset.Int.empty,Ptset.Int.empty)
     in
       Hashtbl.replace h t (pt_cup sbelow sb, pt_cup safter sa)
   in
@@ -158,9 +177,7 @@ let collect_tags tree =
        update tag below1 after2;
        pt_add tag (pt_cup below1 below2), (pt_add tag after1)
   in
-  let b,a = loop (tree_root tree) Ptset.Int.empty in
-    update Tag.pcdata b a;
-    h
+    let _ = loop (tree_root tree) Ptset.Int.empty in h
 
 
 
@@ -197,7 +214,7 @@ let init_naive_contains t s =
   let rec loop n acc l = 
     if n >= j then acc,l
     else
-      let s = get_cached_text t.doc n
+      let s = text_get_cached_text t.doc n
       in
        if matching s 
        then loop (n+1) (n::acc) (l+1) 
@@ -216,27 +233,16 @@ module DocIdSet = struct
                           let compare = compare_node end)
     
 end
-let is_nil t = t.node == Nil
+let is_nil t = t.node == nil
 
-let is_node t = t.node != Nil
+let is_node t = t.node != nil
 
 let node_of_t t  =
   let _ = Tag.init (Obj.magic t) in
   let table = collect_tags t 
   in
-(*
-  let _ = Hashtbl.iter (fun t (sb,sa) ->
-                         Printf.eprintf "'%s' -> { " (Tag.to_string t);
-                         Ptset.iter (fun i ->  Printf.eprintf "'%s' " (Tag.to_string i)) sb;
-                         Printf.eprintf "}\n { ";
-                         Ptset.iter (fun i ->  Printf.eprintf "'%s' " (Tag.to_string i)) sa;
-                         Printf.eprintf "} \n----------------------------------\n";
-                      ) table in
-  let i,j = tree_doc_ids t (tree_root t) in
-    Printf.eprintf "%i docs, range from %i to %i\n%!" (Array.length s) i j;
-    Array.iter (fun i -> print_endline (">>>" ^ i ^ "<<<")) s; *)
     { doc= t; 
-      node = Node(tree_root t);
+      node = tree_root t;
       ttable = table;
     }
 let finalize _ = Printf.eprintf "Release the string list !\n%!"
@@ -266,257 +272,49 @@ let load ?(sample=64) str =
 
 let tag_pool t = pool t.doc
   
-let compare a b = match a.node,b.node  with
-  | Nil, Nil -> 0
-  | Nil,_ -> 1
-  | _ , Nil -> -1
-  | Node(i),Node(j) -> compare_node i j
-  | Text(i,_), Text(j,_) -> compare_node i j
-  | Node(i), Text(_,j) -> compare_node i j
-  | Text(_,i), Node(j) -> compare_node i j 
-
-let equal a b = (compare a b) == 0
-  
-  
-let norm (n : [`Tree ] node ) =  if n == -1 then Nil else Node (n)
-  
+let compare a b = a.node - b.node
+
+let equal a b = a.node == b.node
+   
 let nts = function
-    Nil -> "Nil"
-  | Text (i,j) -> Printf.sprintf "Text (%i, %i)" i j
-  | Node (i) -> Printf.sprintf "Node (%i)"  i
+    -1 -> "Nil"
+  | i -> Printf.sprintf "Node (%i)"  i
       
 let dump_node t = nts t.node
 
-let mk_nil t = { t with node = Nil }             
-let root n = { n with node = norm (tree_root n.doc) }
+let mk_nil t = { t with node = nil }             
+let root n = { n with node = tree_root n.doc }
 
-let is_root n = match n.node with
-  | Node(t) -> (int_of_node t) == 0 
-  | _ -> false
-      
-let is_left n = match n.node with
-  | Node(t) -> (tree_is_first_child n.doc t) && (equal_node nil (tree_prev_text n.doc t))
-  | Text(_,t) -> tree_is_nil t || tree_is_first_child n.doc t
-  | _ -> false
-
-let is_below_right t1 t2 =
-  match (t1.node,t2.node) with
-    | Nil,_ | _,Nil -> false
-    | Node(i1), Node(i2)   -> 
-       tree_is_ancestor t1.doc (tree_parent t1.doc i1) i2
-       && not (tree_is_ancestor t1.doc i1 i2)
-    | Text(_,i1),Node(i2) -> i1 == i2 ||
-       (tree_is_ancestor t1.doc (tree_parent t1.doc i1) i2 && i1 < i2)
-    | Text(_,i1),Text(i,_) ->  
-       let x,y = tree_doc_ids t1.doc i1 in
-         i >= x && i <= y          
-    | Node(i1), Text(i,_) -> 
-       let i2 = tree_next_sibling t1.doc i1 in
-       let x,y = tree_doc_ids t1.doc i2 in
-         i >= x && i <= y
-
-let parent n =  
-  let node' = 
-    match n.node with (* inlined parent *)
-      | Node(t) when (int_of_node t)== 0 -> Nil
-      | Node(t) -> 
-         let txt = tree_prev_text n.doc t in
-           if text_is_empty n.doc txt then
-             let ps = tree_prev_sibling n.doc t in
-               if tree_is_nil ps
-               then
-                 Node(tree_parent n.doc t)
-               else Node(ps)
-           else
-             Text(txt,t)
-      | Text(i,t) ->
-         let ps = tree_prev_doc n.doc i in
-           if tree_is_nil ps
-           then Node (tree_parent_doc n.doc i)
-           else Node(ps)
-      | _ -> failwith "parent"
-  in
-    { n with node = node' }
-
-let node_child n =
-  match n.node with
-    | Node i ->  { n with node= norm(tree_first_child n.doc i) }
-    | _ -> { n with node = Nil }
-
-let node_sibling n =
-  match n.node with
-    | Node i ->  { n with node= norm(tree_next_sibling n.doc i) }
-    | _ -> { n with node = Nil }
-
-let node_sibling_ctx  n _ = 
-  match n.node with
-    | Node i ->  { n with node= norm(tree_next_sibling n.doc i) }
-    | _ -> { n with node = Nil }
-
-
-let first_child n = 
-  let node' = 
-    match n.node with
-      | Node (t) -> 
-         let fs = tree_first_child n.doc t in
-           if equal_node nil fs
-           then 
-             let txt = tree_my_text n.doc t in
-               if equal_node nil txt
-               then Nil
-               else Text(txt,nil)
-           else
-             let txt = tree_prev_text n.doc fs in
-               if equal_node nil txt
-               then Node(fs)
-               else Text(txt, fs) 
-      | Text(_,_) -> Nil
-      | Nil -> failwith "first_child"
-  in
-    { n with node = node'}
+let is_root n = n.node == (tree_root n.doc)
       
-let next_sibling n = 
-  let node' =
-    match n.node with
-      | Text (_,ns) -> norm ns
-      | Node(t) ->
-         let ns = tree_next_sibling n.doc t in
-         let txt = tree_next_text n.doc t in
-           if equal_node nil txt
-           then norm ns
-           else Text(txt, ns)
-      | Nil -> failwith "next_sibling"
-  in
-    { n with node = node'}
-         
-let next_sibling_ctx n _ = next_sibling n
-         
-let left = first_child 
-let right = next_sibling
-    
-let id t = 
-  match t.node with
-    | Node(n)  -> tree_node_xml_id t.doc n
-    | Text(i,_)  -> tree_text_xml_id t.doc i
-    | _ ->  -1 
-       
-let tag t =
-  match t.node with 
-  | Text(_) -> Tag.pcdata
-  | Node(n) -> tree_tag_id t.doc n
-  | Nil -> Tag.nullt
-
-(*
-let select_next tb tf t s = 
-  match s.node  with
-    | Node (below) -> begin
-       match t.node with
-         | Node( n)  ->
-             { t with node = norm (tree_select_next t.doc n (Ptset.Int.to_int_vector tb) (Ptset.Int.to_int_vector tf) below) }
-         | Text (i,n)  when equal_node nil n ->
-             let p = tree_parent_doc t.doc i in
-               { t with node = norm (tree_select_next t.doc p (Ptset.Int.to_int_vector tb) (Ptset.Int.to_int_vector tf) below) }
-         | Text(_,n)  ->
-             if Ptset.mem (tree_tag_id t.doc n) (Ptset.Int.union tb tf)
-             then { t with node=Node(n) }
-             else
-               let vb = Ptset.Int.to_int_vector tb in
-               let vf = Ptset.Int.to_int_vector tf in
-               let node = 
-                 let dsc = tree_select_below t.doc n vb vf in
-                   if equal_node nil dsc
-                   then tree_select_next t.doc n vb vf below
-                   else dsc
-               in
-                 { t with node = norm node }
-         | _ -> {t with node = Nil }
-      end
-       
-    | _ -> { t with node = Nil }
+let is_left n = tree_is_first_child n.doc n.node
 
-  
+let is_below_right t1 t2 = tree_is_ancestor t1.doc (tree_parent t1.doc t1.node) t2.node
 
+let parent n =  { n with node = tree_parent n.doc n.node }
 
-  let select_foll_only  tf t s = 
-    match s.node  with
-      | Node (below)  -> 
-         begin
-           match t.node with
-           | Node(n) ->
-               { t with node= norm (tree_select_foll_only t.doc n (Ptset.Int.to_int_vector tf) below) }
-           | Text(i,n)  when equal_node nil n ->
-               let p = tree_parent_doc t.doc i in
-                 { t with node= norm (tree_select_foll_only t.doc p (Ptset.Int.to_int_vector tf) below) }
-           |  Text(_,n) ->
-                if Ptset.mem (tree_tag_id t.doc n) tf
-                then { t with node=Node(n) }
-                else
-                  let vf = Ptset.Int.to_int_vector tf in
-                  let node = 
-                    let dsc = tree_select_desc_only t.doc n vf in
-                      if tree_is_nil dsc
-                      then tree_select_foll_only t.doc n vf below
-                      else dsc
-                  in
-                    { t with node = norm node }
-           | _ -> { t with node = Nil }
-       end         
-      | _ -> {t with node=Nil }          
-
-let select_below  tc td t=
-  match t.node with
-    | Node( n) -> 
-       let vc = Ptset.Int.to_int_vector tc
-       in
-       let vd = Ptset.Int.to_int_vector td
-       in
-         { t with node= norm(tree_select_below t.doc n vc vd) }
-    | _ -> { t with node=Nil }
-       
-       
-let select_desc_only  td t =
-  match t.node with
-    | Node(n) -> 
-       let vd = Ptset.Int.to_int_vector td
-       in
-         { t with node = norm(tree_select_desc_only t.doc n vd) }
-    | _ -> { t with node = Nil }
-
-*)
-let tagged_desc tag t =
-  match t.node with
-    | Node(n) ->       
-         { t with node = norm(tree_tagged_desc t.doc n tag) }
-    | _ -> { t with node = Nil }
-
-
-let tagged_foll_ctx tag t s =
-    match s.node  with
-      | Node (below)  -> 
-         begin
-           match t.node with
-           | Node(n) ->
-               { t with node= norm (tree_tagged_foll_below t.doc n tag below) }
-           | Text(i,n)  when equal_node nil n ->
-               let p = tree_prev_doc t.doc i in
-                 { t with node= norm (tree_tagged_foll_below t.doc p tag below) }
-           |  Text(_,n) ->
-                if (tree_tag_id t.doc n) == tag
-                then { t with node=Node(n) }
-                else
-                  let node = 
-                    let dsc = tree_tagged_desc t.doc n tag in
-                      if tree_is_nil dsc
-                      then tree_tagged_foll_below t.doc n tag below
-                      else dsc
-                  in
-                    { t with node = norm node }
-           | _ -> { t with node = Nil }
-         end       
-      | _ -> {t with node=Nil }          
+let first_child n = { n with node = tree_first_child n.doc n.node }
+let tagged_child tag n  =  { n with node = tree_tagged_child n.doc n.node tag }
+let select_child ts n  =  { n with node = tree_select_child n.doc n.node (ptset_to_vector ts) }
 
+let next_sibling n = { n with node = tree_next_sibling n.doc n.node }
+let tagged_sibling tag n  =  { n with node = tree_tagged_sibling n.doc n.node tag }
+let select_sibling ts n  =  { n with node = tree_select_foll_sibling n.doc n.node (ptset_to_vector ts) }
 
+let next_sibling_ctx n _ = next_sibling n
+let tagged_sibling_ctx tag n  _ = tagged_sibling tag n
+let select_sibling_ctx ts n  _ = select_sibling ts n
 
+let id t = tree_node_xml_id t.doc t.node
+       
+let tag t = if t.node == nil then Tag.nullt else tree_tag_id t.doc t.node
+
+let tagged_desc tag n = { n with node = tree_tagged_desc n.doc n.node tag }
+let select_desc ts n  =  { n with node = tree_select_desc n.doc n.node (ptset_to_vector ts) }
+
+let tagged_foll_ctx tag t ctx =
+  { t with node = tree_tagged_foll_below t.doc t.node tag ctx.node }
+let select_foll_ctx ts n ctx  =  { n with node = tree_select_foll_below n.doc n.node (ptset_to_vector ts) ctx.node }
 
 let last_idx = ref 0
 let array_find a i j =
@@ -531,207 +329,68 @@ let array_find a i j =
     else loop !last_idx i j 
 
 
-       
-let text_below t = 
-  let l = Array.length !contains_array in
-      match t.node with
-       | Node(n)  -> 
-           let i,j = tree_doc_ids t.doc n in
-           let id = if l == 0 then i else (array_find !contains_array i j)
-           in
-(*           Printf.printf "Looking for text below node %i with tag %s in range %i %i, in array : [|\n%!"
-               n (Tag.to_string (tree_tag_id t.doc n)) i j;
-             Array.iter (fun i -> Printf.printf "%i " (int_of_node i )) !contains_array;
-             Printf.printf "|]\nResult is %i\n%!" id;        *)
-             if id == nil then  
-               { t with  node=Nil }
-             else
-               { t with  node = Text(id, tree_next_sibling t.doc (tree_prev_doc t.doc id)) }
-       | _ -> (*Printf.printf "Here\n%!"; *)
-           { t with node = Nil }
-           
-let text_next t root =
-  let l = Array.length !contains_array in
-      let inf = match t.node with
-       | Node(n)  -> snd(tree_doc_ids t.doc n)+1
-       | Text(i,_)  -> i+1
-       | _ -> assert false
-      in
-       match root.node with
-         | Node (n)  ->
-             let _,j = tree_doc_ids t.doc n in      
-             let id = if l == 0 then if inf > j then nil else inf
-             else array_find !contains_array inf j
-             in
-               if id == nil then  { t with node= Nil }
-               else
-                 { t with node = Text(id,tree_next_sibling t.doc (tree_prev_doc t.doc id)) }
-         | _ -> { t with node = Nil}
-                 
-
-(*               
-    let subtree_tags t tag =
-      match t with 
-         { doc = d; node = Node(NC n) } -> 
-           subtree_tags d n tag
-       | _ -> 0
-
-    let select_desc_array = ref [| |]
-    let idx = ref 0
-
-    let init_tagged_next t tagid =
-      let l = subtree_tags (root t) tagid
-      in
-       tagged_desc_array := Array.create l { t with node= Nil };
-       let i = ref 0 in
-         let rec collect t =
-           if is_node t then begin
-             if tag t == tagid then
-               begin
-                 !tagged_desc_array.(!i) <- t;
-                 incr i;
-               end;
-             collect (first_child t);
-             collect (next_sibling t)
-           end;
-         in
-           collect t;
-           idx := 0
-
-    let print_id ppf v = 
-      let pr x= Format.fprintf ppf x in
-       match v with
-           { node=Nil } -> pr "NULLT: -1"
-         | { node=String(i) } | { node=Node(SC(i,_)) } -> pr "DocID: %i" (int_of_node i)
-         | { node=Node(NC(i)) } -> pr "Node: %i" (int_of_node i)
-             
-             
-         
-(*    let tagged_next t tag = 
-      if !idx >= Array.length !tagged_desc_array 
-      then {t with node=Nil}
-      else
-       let r = !tagged_desc_array.(!idx) 
-       in
-         incr idx; r
-*)               
-
-
-    let has_tagged_foll t tag = is_node (tagged_foll t tag)
-    let has_tagged_desc t tag = is_node (tagged_desc t tag)
-
-    let contains t s = 
-      Array.fold_left (fun a i -> DocIdSet.add i a) DocIdSet.empty (Text.contains t.doc s)
-
-
-    let contains_old t s = 
-      let regexp = Str.regexp_string s in
-      let matching arg = 
-       try
-         let _ = Str.search_forward regexp arg 0;
-         in true
-       with _ -> false
-      in
-      let rec find t acc = match t.node with
-       | Nil -> acc
-       | String i ->
-           if  matching (string t) then DocIdSet.add i acc else acc
-       | Node(_) ->  (find (left t )) ((find (right t))  acc)
-      in
-       find t DocIdSet.empty
-
-
-    let contains_iter t s = 
-      let regexp = Str.regexp_string s in
-      let matching arg = 
-       try
-         let _ = Str.search_forward regexp arg 0;
-         in true
-       with _ -> false
-      in
-      let size = Text.size t.doc in
-      let rec find acc n = 
-       if n == size then acc
-       else
-         find 
-           (if matching (Text.get_cached_text t.doc (Obj.magic n)) then 
-            DocIdSet.add (Obj.magic n) acc
-          else acc) (n+1)
-      in
-       find DocIdSet.empty 0
-
-
-
-
-    let count_contains t s =   Text.count_contains t.doc s
-*)
 
   let count t s = text_count t.doc s
-(*
-    let is_left t =
-      if is_root t then false
-      else
-      if tag (parent t) == Tag.pcdata then false
-      else
-       let u = left (parent t) in
-         (id t) == (id u)
-*)
+
   let print_xml_fast outc t =
     let rec loop ?(print_right=true) t = 
-      match t.node with 
-      | Nil -> ()    
-      | Text(i,n) -> output_string outc (get_cached_text t.doc i);
+      if t.node != nil 
+      then 
+       let tagid = tree_tag_id t.doc t.node in
+         if tagid==Tag.pcdata
+         then output_string outc (text_get_cached_text t.doc t.node);
          if print_right
-         then loop (right t)
-      | Node (n) -> 
-         let tg = Tag.to_string (tag t) in
-         let l = left t 
-         and r = right t 
-         in
-           output_char outc  '<';
-           output_string outc  tg;
-           ( match l.node with
-                 Nil -> output_string outc  "/>"
-               | Node(_) when Tag.equal (tag l) Tag.attribute -> 
-                   (loop_attributes (left l);
-                    match (right l).node with
-                      | Nil -> output_string outc  "/>"
-                      | _ -> 
-                          output_char outc  '>'; 
-                          loop (right l);
-                          output_string outc  "</";
-                          output_string outc  tg;
-                          output_char outc '>' )
-               | _ ->
+         then loop (next_sibling t)
+           
+         else
+           let tagstr = Tag.to_string tagid in
+           let l = first_child t 
+           and r = next_sibling t 
+           in
+             output_char outc  '<';
+             output_string outc  tagstr;
+             if l.node == nil then output_string outc  "/>"
+             else 
+               if (tag l) == Tag.attribute then
+                 begin
+                   loop_attributes (first_child l);
+                   if (next_sibling l).node == nil then output_string outc  "/>"
+                   else  
+                     begin 
+                       output_char outc  '>'; 
+                       loop (next_sibling l);
+                       output_string outc  "</";
+                       output_string outc  tagstr;
+                       output_char outc '>';
+                     end;
+                 end
+               else
+                 begin
                    output_char outc  '>'; 
                    loop l;
                    output_string outc "</";
-                   output_string outc tg;
-                   output_char outc '>'
-           );if print_right then loop r
-    and loop_attributes a =      
-       match a.node with 
-         | Node(_) ->
-             let value =
-               match (left a).node with
-                 | Text(i,_) -> (get_cached_text a.doc i)
-                 | _ -> assert false
-             in
-               output_char outc ' ';
-               output_string outc (Tag.to_string (tag a));
-               output_string outc "=\"";
-               output_string outc value;
-               output_char outc '"';
-               loop_attributes (right a)
-         | _ -> ()
+                   output_string outc tagstr;
+                   output_char outc '>';
+                 end;
+             if print_right then loop r
+    and loop_attributes a =    
+      let s = (Tag.to_string (tag a)) in
+      let attname = String.sub s 3 ((String.length s) -3) in
+       output_char outc ' ';
+       output_string outc attname;
+       output_string outc "=\"";
+       output_string outc (text_get_cached_text t.doc
+                             (tree_my_text a.doc (first_child a).node));
+       output_char outc '"';
+       loop_attributes (next_sibling a)
     in
        loop ~print_right:false t
          
          
     let print_xml_fast outc t = 
-      if Tag.to_string (tag t) = "" then
+      if (tag t) = Tag.document_node then
        print_xml_fast outc (first_child t)
-      else print_xml_fast outc t
+      else print_xml_fast outc t 
        
 
 let tags_below t tag = 
@@ -742,99 +401,46 @@ let tags_after t tag =
 
 let tags t tag = Hashtbl.find t.ttable tag
 
-let  tagged_lowest t tag = 
-  let rec loop_lowest i = 
-    let j = tree_tagged_desc t.doc i tag in
-    if tree_is_nil j then i else loop_lowest j
-  in
-    match t.node with
-      | Node i ->
-         let j = loop_lowest i in 
-           { t with 
-               node = norm(
-                 if tree_is_nil j then
-                   if (tree_tag_id t.doc i) == tag
-                   then i
-                   else j
-                 else j) }
-      | Nil -> t
-      | _ -> assert false
-         
-         
-let tagged_next t tag = 
-  match t.node with
-    | Node(i) -> 
-       let n = tree_tagged_foll_below t.doc i tag (Obj.magic 0)
-       in
-         if tree_is_nil  n then mk_nil t
-         else 
-           tagged_lowest { t with node = Node n } tag
-    | Nil -> t
-    | _ -> assert false
 
 let rec binary_parent t = 
-  let res = 
-  match t.node with
-  | Node(0) -> { t with node = Nil }
-  | Node(i) ->
-      let j = tree_prev_sibling t.doc i in
-       if tree_is_nil j then
-         let idoc = tree_prev_text t.doc i in
-           if equal_node nil idoc then
-             { t with node = Node (tree_parent t.doc i) }
-           else 
-             { t with node = Text(idoc,i) }
-       else
-         let idoc = tree_prev_text t.doc i in
-           if equal_node nil idoc then
-             { t with node = Node (j) }
-           else { t with node = Text(idoc,i) }
-  | Text(d,i) ->       
-      if tree_is_nil i then
-       let n = tree_parent_doc t.doc d in
-       let lc = tree_last_child t.doc n in
-         if tree_is_nil lc then {t with node = Node n }
-         else { t with node = Node lc }
-      else
-       let j = tree_prev_sibling t.doc i in
-         if tree_is_nil j then
-           { t with node = Node (tree_parent t.doc i) }
-         else { t with node = Node j }
-  | Nil -> t
-  in match res.node with
-    | Text(idoc,t) -> 
-       if (Array.length !contains_array) != 0
-       then if in_array !contains_array idoc then res
-       else binary_parent res
-       else res
-    | _ -> res
-
-let benchmark_text t =
-  let doc = t.doc in
-    match (root t).node with
-      | Node i -> let _,size = tree_doc_ids doc i in
-         Printf.eprintf "%i will take ~ %i seconds\n%!"
-           size (size/10000) ;
-       let a = Array.create size "" in
-         for i = 0 to size 
-         do
-           a.(i) <- text_get_tc_text t.doc (i+1)
-         done; a
-      | _ -> assert false
+  if tree_is_first_child t.doc t.node
+  then { t with node = tree_parent t.doc t.node }
+  else { t with node = tree_prev_sibling t.doc t.node }
 
 let doc_ids (t:t) : (int*int) = 
-  (Obj.magic (
-    match t.node with
-      | Node i -> tree_doc_ids t.doc i
-      | Text (i,_) -> (i,i)
-      | Nil -> (nil,nil)
-   ))
-
-let subtree_tags t tag = match t.node with
-  | Nil -> 0
-  | Node(i) -> tree_subtree_tags t.doc i tag
-  | Text(_,i) -> tree_subtree_tags t.doc i tag
-
-let get_text t = match t.node with
-  | Text(i,_) -> get_cached_text t.doc i
-  | _ -> ""
+  (Obj.magic (tree_doc_ids t.doc t.node))
+
+let subtree_tags t tag = 
+  if t.node == nil then 0 else
+    tree_subtree_tags t.doc t.node tag
+
+let get_text t =
+  let tid = tree_my_text t.doc t.node in
+    if tid == nil then "" else 
+      let a, b = tree_doc_ids t.doc (tree_root t.doc) in
+      let _ = Printf.eprintf "Trying to take text %i of node %i in %i %i\n%!" tid t.node a b in
+       text_get_cached_text t.doc tid
+
+
+let dump_tree fmt t = 
+  let rec loop tree n =
+    if tree != nil then
+      let tag = (tree_tag_id t.doc tree ) in
+      let tagstr = Tag.to_string tag in
+       let tab = String.make n ' ' in
+
+         if tag == Tag.pcdata || tag == Tag.attribute_data 
+         then 
+           Format.fprintf fmt "%s<%s>%s</%s>\n" 
+             tab tagstr (text_get_cached_text t.doc (tree_my_text t.doc tree)) tagstr
+         else begin
+           Format.fprintf fmt "%s<%s>\n" tab tagstr;
+           loop (tree_first_child t.doc tree) (n+2);
+           Format.fprintf fmt "%s</%s>\n%!" tab tagstr;
+         end;
+         loop (tree_next_sibling t.doc tree) n
+  in
+    loop (tree_root t.doc) 0
+;;
+
+       
index d8a49c9..3f72894 100644 (file)
--- a/tree.mli
+++ b/tree.mli
@@ -16,39 +16,44 @@ val root : t -> t
 val is_root : t -> bool
 val parent : t -> t
 val first_child : t -> t
+val tagged_child : Tag.t -> t ->  t
+val select_child : Ptset.Int.t -> t ->  t
+
 val next_sibling : t -> t
+
+val tagged_sibling : Tag.t -> t ->  t
+val tagged_sibling_ctx : Tag.t -> t -> t -> t
+
+val select_sibling : Ptset.Int.t -> t -> t 
+val select_sibling_ctx : Ptset.Int.t -> t -> t -> t
+
 val next_sibling_ctx : t -> t -> t
-val left : t -> t
-val right : t -> t
-val id : t -> int
+
 val tag : t -> Tag.t
-val text_below : t -> t
-val text_next : t -> t -> t
+val id : t -> int
+
 val tagged_desc : Tag.t -> t -> t
+val select_desc : Ptset.Int.t -> t -> t
+
 val tagged_foll_ctx : Tag.t -> t -> t -> t
-(*
-val select_desc_only : Ptset.Int.t -> t -> t
-val select_foll_only : Ptset.Int.t -> t -> t -> t
-val select_below :   Ptset.Int.t -> Ptset.Int.t ->  t -> t
-val select_next :  Ptset.Int.t -> Ptset.Int.t -> t -> t -> t
-*)
+val select_foll_ctx : Ptset.Int.t -> t -> t -> t
+
 val count : t -> string -> int
 val print_xml_fast : out_channel -> t -> unit
-val node_child : t -> t
-val node_sibling : t -> t
-val node_sibling_ctx : t -> t -> t
+
 val tags_below : t -> Tag.t -> Ptset.Int.t
 val tags_after : t -> Tag.t -> Ptset.Int.t
 val tags : t -> Tag.t -> Ptset.Int.t*Ptset.Int.t
 val is_below_right : t -> t -> bool
 val is_left : t -> bool
-val tagged_lowest : t -> Tag.t -> t
-val tagged_next : t -> Tag.t -> t
+
 val binary_parent : t -> t
-val benchmark_text : t -> string array
+
 val count_contains : t -> string -> int
 val unsorted_contains : t -> string -> unit
 val text_size : t -> int
 val doc_ids : t -> int*int
 val subtree_tags : t -> Tag.t -> int
 val get_text : t -> string
+
+val dump_tree : Format.formatter -> t -> unit