OCamlDriver.cpp

   1 /**************************************
   2  * OCamlDriver.cpp
   3  * -------------------
   4  * An Ocaml Driver which calls the C++ methods and
   5  * adds a C wrapper interface with OCaml code.
   6  *
   7  * Author: Kim Nguyen
   8  * Date: 04/11/08
   9  */
  10
  11 /***
  12  *  Conventions:
  13  *  functions never doing any allocation (non caml_alloc*, caml_copy_string,...)
  14  *  have NOALLOC in the comment and their external declaration can have "noalloc"
  15  */
  16
  17
  18 #include <unordered_set>
  19 #include <algorithm>
  20 #include "XMLDocShredder.h"
  21 #include "XMLTree.h"
  22 #include "Utils.h"
  23
  24 extern "C" {
  25 /* OCaml memory managment */
  26 #include <caml/mlvalues.h>
  27 #include <caml/alloc.h>
  28 #include <caml/memory.h>
  29 #include <caml/callback.h>
  30 #include <caml/fail.h>
  31 #include <caml/custom.h>
  32 #include "results.h"
  33 #include <stdio.h>
  34
  35 #define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) ))
  36 #define NOT_IMPLEMENTED(s)  (caml_failwith(s))
  37 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
  38 #define HSET(x) ((TagIdSet*)((* (TagIdSet**) Data_custom_val(x))))
  39 #define TEXTCOLLECTION(x)
  40 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
  41 #define TAGVAL(i) ((TagType) (Int_val(i)))
  42 #define XMLTREE_ROOT 0
  43 #define NoAlloc
  44
  45
  46   static struct custom_operations ops;
  47   static struct custom_operations set_ops;
  48   static value * cpp_exception = NULL;
  49   static bool ops_initialized = false;
  50
  51 }
  52
  53 extern "C" void caml_xml_tree_finalize(value tree){
  54   delete XMLTREE(tree);
  55   return;
  56 }
  57
  58 extern "C" void caml_hset_finalize(value hblock){
  59   delete HSET(hblock);
  60   return;
  61 }
  62
  63 extern "C"  value caml_init_lib (value unit) {
  64   CAMLparam1(unit);
  65   if (!ops_initialized){
  66
  67
  68   ops.identifier = (char*) "XMLTree";
  69   ops.finalize = caml_xml_tree_finalize;
  70   set_ops.identifier = (char*) "unordered_set";
  71   set_ops.finalize = caml_hset_finalize;
  72
  73   cpp_exception = caml_named_value("CPlusPlusError");
  74   if (cpp_exception == NULL){
  75     string s = "FATAL: Unregistered exception ";
  76     s += "CPlusPlusError";
  77     caml_failwith(s.c_str());
  78   };
  79
  80   ops_initialized = true;
  81
  82   };
  83   CAMLreturn(Val_unit);
  84
  85 }
  86 extern "C"  value caml_shredder_parse(XMLDocShredder *shredder){
  87   CAMLparam0();
  88   CAMLlocal1(doc);
  89   XMLTree * tree;
  90   shredder->processStartDocument("");
  91   shredder->parse();
  92   shredder->processEndDocument();
  93   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
  94   tree = (XMLTree *) shredder->getXMLTree();
  95   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
  96   CAMLreturn(doc);
  97
  98 }
  99
 100 extern "C"  value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
 101   CAMLparam1(uri);
 102   CAMLlocal1(doc);
 103   char *fn = String_val(uri);
 104   XMLDocShredder * shredder;
 105   try {
 106     shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
 107     doc = caml_shredder_parse(shredder);
 108     delete shredder;
 109   }
 110   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 111   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 112   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 113   CAMLreturn (doc);
 114
 115 }
 116 extern "C"  value caml_call_shredder_string(value data,value sf, value iet, value dtc){
 117   CAMLparam1(data);
 118   CAMLlocal1(doc);
 119   XMLDocShredder * shredder;
 120   unsigned int ln = caml_string_length(data);
 121   unsigned char *fn = (unsigned char*) String_val(data);
 122   try {
 123     shredder = new  XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));
 124     doc = caml_shredder_parse(shredder);
 125     delete shredder;
 126   }
 127   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 128   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 129   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 130   CAMLreturn(doc);
 131 }
 132
 133 extern "C"  value caml_xml_tree_save(value tree,value fd, value str){
 134   CAMLparam3(tree,fd,str);
 135   XMLTREE(tree)->Save(Int_val(fd), String_val(str));
 136   CAMLreturn (Val_unit);
 137 }
 138
 139 extern "C"  value caml_xml_tree_load(value fd, value str, value load_tc,value sf){
 140   CAMLparam4(fd,str,load_tc,sf);
 141   CAMLlocal1(doc);
 142   XMLTree * tree;
 143   try {
 144     tree = XMLTree::Load(Int_val(fd),String_val(str),Bool_val(load_tc),Int_val(sf));
 145     printf("Pointer to tree is %p\n", (void*) tree);
 146     doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
 147     memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
 148     CAMLreturn(doc);
 149   }
 150   catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); }
 151   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 152   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 153   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 154 }
 155
 156
 157 /**
 158  *  Interface to the TextCollection
 159  */
 160
 161 /**
 162  *  Utility functions
 163  */
 164
 165 extern "C"  value caml_text_collection_get_text(value tree, value id){
 166   CAMLparam2(tree,id);
 167   CAMLlocal1(str);
 168   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
 169   str = caml_copy_string((const char*)txt);
 170   CAMLreturn (str);
 171 }
 172
 173
 174 extern "C"  value caml_text_collection_empty_text(value tree,value id){
 175   CAMLparam2(tree,id);
 176   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
 177 }
 178
 179 bool docId_comp(DocID x, DocID y) { return x < y; };
 180
 181 /**
 182  * Existential queries
 183  */
 184
 185 extern "C"  value caml_text_collection_is_prefix(value tree,value str){
 186   CAMLparam2(tree,str);
 187   uchar * cstr = (uchar *) String_val(str);
 188   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsPrefix(cstr)));
 189 }
 190
 191 extern "C"  value caml_text_collection_is_suffix(value tree,value str){
 192   CAMLparam2(tree,str);
 193   uchar * cstr = (uchar *) String_val(str);
 194   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsSuffix(cstr)));
 195 }
 196 extern "C"  value caml_text_collection_is_equal(value tree,value str){
 197   CAMLparam2(tree,str);
 198   uchar * cstr = (uchar *) String_val(str);
 199   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsEqual(cstr)));
 200 }
 201 extern "C"  value caml_text_collection_is_contains(value tree,value str){
 202   CAMLparam2(tree,str);
 203   uchar * cstr = (uchar *) String_val(str);
 204   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
 205 }
 206
 207 extern "C"  value caml_text_collection_is_lessthan(value tree,value str){
 208   CAMLparam2(tree,str);
 209   uchar * cstr = (uchar *) String_val(str);
 210   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsLessThan(cstr)));
 211 }
 212
 213
 214 /**
 215  * Count Queries
 216  */
 217
 218 /**
 219  *  Global counting
 220  */
 221 extern "C"  value caml_text_collection_count(value tree,value str){
 222   CAMLparam2(tree,str);
 223   uchar * cstr = (uchar *) String_val(str);
 224   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
 225 }
 226
 227 extern "C"  value caml_text_collection_count_prefix(value tree,value str){
 228   CAMLparam2(tree,str);
 229   uchar * cstr = (uchar *) String_val(str);
 230   CAMLreturn (Val_int((XMLTREE(tree)->CountPrefix(cstr))));
 231 }
 232
 233 extern "C"  value caml_text_collection_count_suffix(value tree,value str){
 234   CAMLparam2(tree,str);
 235   uchar * cstr = (uchar *) String_val(str);
 236   CAMLreturn (Val_int((XMLTREE(tree)->CountSuffix(cstr))));
 237 }
 238
 239 extern "C"  value caml_text_collection_count_equal(value tree,value str){
 240   CAMLparam2(tree,str);
 241   uchar * cstr = (uchar *) String_val(str);
 242   CAMLreturn (Val_int((XMLTREE(tree)->CountEqual(cstr))));
 243 }
 244
 245 extern "C"  value caml_text_collection_count_contains(value tree,value str){
 246   CAMLparam2(tree,str);
 247   uchar * cstr = (uchar *) String_val(str);
 248   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
 249 }
 250
 251 extern "C"  value caml_text_collection_count_lessthan(value tree,value str){
 252   CAMLparam2(tree,str);
 253   uchar * cstr = (uchar *) String_val(str);
 254   CAMLreturn (Val_int((XMLTREE(tree)->CountLessThan(cstr))));
 255 }
 256
 257 static value sort_alloc_array(std::vector<DocID> results, value resarray){
 258   std::sort(results.begin(), results.end(), docId_comp);
 259     size_t s = results.size();
 260     resarray = caml_alloc_tuple(s);
 261     for (size_t i = 0; i < s ;i++){
 262       caml_initialize(&Field(resarray,i),Val_int(results[i]));
 263     };
 264     return resarray;
 265
 266 }
 267
 268 /**
 269  * Full reporting queries
 270  */
 271
 272 extern "C"  value caml_text_collection_prefix(value tree,value str){
 273   CAMLparam2(tree,str);
 274   CAMLlocal1(resarray);
 275   uchar * cstr = (uchar *) String_val(str);
 276   std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
 277   CAMLreturn (sort_alloc_array(results,resarray));
 278 }
 279
 280 extern "C"  value caml_text_collection_suffix(value tree,value str){
 281   CAMLparam2(tree,str);
 282   CAMLlocal1(resarray);
 283   uchar * cstr = (uchar *) String_val(str);
 284   std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
 285   CAMLreturn (sort_alloc_array(results,resarray));
 286 }
 287
 288 extern "C"  value caml_text_collection_equals(value tree,value str){
 289   CAMLparam2(tree,str);
 290   CAMLlocal1(resarray);
 291   uchar * cstr = (uchar *) strdup(String_val(str));
 292   std::vector<DocID> results = XMLTREE(tree)->Equals(cstr);
 293   free(cstr);
 294   CAMLreturn (sort_alloc_array(results,resarray));
 295 }
 296
 297 extern "C"  value caml_text_collection_contains(value tree,value str){
 298   CAMLparam2(tree,str);
 299   CAMLlocal1(resarray);
 300   uchar * cstr = (uchar *) String_val(str);
 301   std::vector<DocID> results = XMLTREE(tree)->Contains(cstr);
 302   CAMLreturn (sort_alloc_array(results,resarray));
 303 }
 304
 305 extern "C"  value caml_text_collection_lessthan(value tree,value str){
 306   CAMLparam2(tree,str);
 307   CAMLlocal1(resarray);
 308   uchar * cstr = (uchar *) String_val(str);
 309   std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
 310   CAMLreturn (sort_alloc_array(results,resarray));
 311 }
 312
 313 /** Full reporting into a bit vector
 314  */
 315
 316 extern "C"  value caml_text_collection_prefix_bv(value tree,value str){
 317   CAMLparam2(tree,str);
 318   uchar * cstr = (uchar *) strdup(String_val(str));
 319   std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
 320   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
 321   for (unsigned int i=0; i < results.size(); i++)
 322     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
 323   free(cstr);
 324   CAMLreturn ((value) bv);
 325 }
 326
 327 extern "C"  value caml_text_collection_suffix_bv(value tree,value str){
 328   CAMLparam2(tree,str);
 329   uchar * cstr = (uchar *) strdup(String_val(str));
 330   std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
 331   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
 332   for (unsigned int i=0; i < results.size(); i++)
 333     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
 334   free(cstr);
 335   CAMLreturn ((value) bv);
 336 }
 337
 338 extern "C"  value caml_text_collection_equals_bv(value tree,value str){
 339   CAMLparam2(tree,str);
 340   uchar * cstr = (uchar *) strdup(String_val(str));
 341   XMLTree* xt = XMLTREE(tree);
 342   std::vector<DocID> results = xt->Equals(cstr);
 343   std::vector<bool> *bv = new std::vector<bool>(xt->Size(),false);
 344   for (unsigned int i=0; i < results.size(); i++)
 345     bv->at(xt->Parent(xt->ParentNode(results[i])))=true;
 346   free(cstr);
 347   CAMLreturn ((value) bv);
 348 }
 349
 350
 351 extern "C"  value caml_text_collection_contains_bv(value tree,value str){
 352   CAMLparam2(tree,str);
 353   uchar * cstr = (uchar *) strdup(String_val(str));
 354   XMLTree* xt = XMLTREE(tree);
 355   std::vector<DocID> results = xt->Contains(cstr);
 356   std::vector<bool> *bv = new std::vector<bool>(xt->Size(),false);
 357   for (unsigned int i=0; i < results.size(); i++){
 358     bv->at(xt->Parent(xt->ParentNode(results[i])))=true;
 359   }
 360   free(cstr);
 361   CAMLreturn ((value) bv);
 362 }
 363
 364 extern "C" value caml_text_collection_contains_bv_update(value tree,value str,value vbv){
 365   CAMLparam3(tree,str,vbv);
 366   uchar * cstr = (uchar *) strdup(String_val(str));
 367   XMLTree* xt = XMLTREE(tree);
 368   std::vector<DocID> results = xt->Contains(cstr);
 369   std::vector<bool> *bv = (std::vector<bool> *) vbv;
 370   for (unsigned int i=0; i < results.size(); i++){
 371     /** Hack for the Techfest demo */
 372     (*bv)[xt->Parent(xt->Parent(xt->ParentNode(results[i])))]=true;
 373   }
 374   free(cstr);
 375   CAMLreturn ((value) bv);
 376 }
 377 extern "C" value caml_text_collection_contains_bv_update_list(value tree,value str,value acc,value vbv,value count){
 378   CAMLparam4(tree,str,acc,vbv);
 379   CAMLlocal1(head);
 380   uchar * cstr = (uchar *) strdup(String_val(str));
 381   XMLTree* xt = XMLTREE(tree);
 382   std::vector<DocID> results = xt->Contains(cstr);
 383   std::vector<bool> *bv = (std::vector<bool> *) vbv;
 384   treeNode idx;
 385   int acc_count = Int_val(count);
 386   for (unsigned int i=0; i < results.size(); i++){
 387     idx = xt->Parent(xt->Parent(xt->ParentNode(results[i])));
 388     if (!(*bv)[idx]) {
 389         (*bv)[idx]=true;
 390         head = caml_alloc_tuple(2);
 391         caml_initialize(&Field(head,0),Val_int(idx));
 392         caml_initialize(&Field(head,1),acc);
 393         acc=head;
 394         acc_count++;
 395     };
 396   };
 397   free(cstr);
 398   head = caml_alloc_tuple(3);
 399   caml_initialize(&Field(head,0),acc);
 400   caml_initialize(&Field(head,1),(value) bv);
 401   caml_initialize(&Field(head,2),Val_int(acc_count));
 402   CAMLreturn (head);
 403 }
 404
 405 extern "C"  value caml_text_collection_lessthan_bv(value tree,value str){
 406   CAMLparam2(tree,str);
 407   uchar * cstr = (uchar *) strdup(String_val(str));
 408   std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
 409   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
 410   for (unsigned int i=0; i < results.size(); i++)
 411     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
 412   free(cstr);
 413   CAMLreturn ((value) bv);
 414 }
 415
 416 /*************************************************************************/
 417
 418 /**
 419  *  XMLTree bindings
 420  *  All of the functions here call the _unsafe version and implement the logics themselves
 421  *  (test for NULLT and so on). This avoids one indirection + one call when the tests fails.
 422  */
 423
 424
 425 NoAlloc extern "C"  value caml_xml_tree_root(value tree){
 426   return (Val_int(XMLTREE_ROOT));
 427 }
 428
 429 NoAlloc extern "C"  value caml_xml_tree_size(value tree){
 430   return (Val_int(XMLTREE(tree)->Size()));
 431 }
 432
 433 NoAlloc extern "C"  value caml_xml_tree_num_tags(value tree){
 434   return (Val_int(XMLTREE(tree)->NumTags()));
 435 }
 436
 437 NoAlloc extern "C"  value caml_xml_tree_subtree_size(value tree, value node){
 438   return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(node))));
 439 }
 440
 441 NoAlloc extern "C"  value caml_xml_tree_subtree_tags(value tree, value node, value tag){
 442   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(node), TAGVAL(tag))));
 443 }
 444
 445 NoAlloc extern "C"  value caml_xml_tree_subtree_elements(value tree, value node){
 446   return (Val_int(XMLTREE(tree)->SubtreeElements(TREENODEVAL(node))));
 447 }
 448
 449 NoAlloc extern "C"  value caml_xml_tree_is_leaf(value tree, value node){
 450   return (Val_bool(XMLTREE(tree)->IsLeaf(TREENODEVAL(node))));
 451 }
 452
 453 NoAlloc extern "C"  value caml_xml_tree_is_ancestor(value tree, value node1,value node2){
 454   return (Val_bool(XMLTREE(tree)->IsAncestor(TREENODEVAL(node1),TREENODEVAL(node2))));
 455 }
 456
 457 NoAlloc extern "C"  value caml_xml_tree_is_child(value tree, value node1,value node2){
 458   return (Val_bool(XMLTREE(tree)->IsChild(TREENODEVAL(node1),TREENODEVAL(node2))));
 459 }
 460
 461 NoAlloc extern "C"  value caml_xml_tree_is_first_child(value tree, value node){
 462   return (Val_bool(XMLTREE(tree)->IsFirstChild(TREENODEVAL(node))));
 463 }
 464
 465 NoAlloc extern "C"  value caml_xml_tree_num_children(value tree, value node){
 466   return (Val_int(XMLTREE(tree)->NumChildren(TREENODEVAL(node))));
 467 }
 468
 469 NoAlloc extern "C"  value caml_xml_tree_child_number(value tree, value node){
 470   return (Val_int(XMLTREE(tree)->ChildNumber(TREENODEVAL(node))));
 471 }
 472
 473 NoAlloc extern "C"  value caml_xml_tree_depth(value tree, value node){
 474   return (Val_int(XMLTREE(tree)->Depth(TREENODEVAL(node))));
 475 }
 476
 477 NoAlloc extern "C"  value caml_xml_tree_preorder(value tree, value node){
 478   return (Val_int(XMLTREE(tree)->Preorder(TREENODEVAL(node))));
 479 }
 480
 481 NoAlloc extern "C"  value caml_xml_tree_postorder(value tree, value node){
 482   return (Val_int(XMLTREE(tree)->Postorder(TREENODEVAL(node))));
 483 }
 484
 485 NoAlloc extern "C"  value caml_xml_tree_tag(value tree, value node){
 486   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(node))));
 487 }
 488
 489 extern "C"  value caml_xml_tree_doc_ids(value tree, value node){
 490   CAMLparam2(tree,node);
 491   CAMLlocal1(tuple);
 492   range ids;
 493   tuple = caml_alloc(2,0);
 494   ids = XMLTREE(tree)->DocIds(Int_val(node));
 495   Store_field(tuple,0,Val_int(ids.min));
 496   Store_field(tuple,1,Val_int(ids.max));
 497   CAMLreturn (tuple);
 498 }
 499
 500 NoAlloc extern "C"  value caml_xml_tree_parent(value tree, value node){
 501   return (Val_int(XMLTREE(tree)->Parent(TREENODEVAL(node))));
 502 }
 503
 504 NoAlloc extern "C"  value caml_xml_tree_child(value tree, value node,value idx){
 505   return (Val_int(XMLTREE(tree)->Child(TREENODEVAL(node),Int_val(idx))));
 506 }
 507
 508 NoAlloc extern "C"  value caml_xml_tree_first_child(value tree, value node){
 509   return (Val_int(XMLTREE(tree)->FirstChild(TREENODEVAL(node))));
 510 }
 511
 512 NoAlloc extern "C"  value caml_xml_tree_first_element(value tree, value node){
 513   return (Val_int(XMLTREE(tree)->FirstElement(TREENODEVAL(node))));
 514 }
 515
 516 NoAlloc extern "C"  value caml_xml_tree_last_child(value tree, value node){
 517   return (Val_int(XMLTREE(tree)->LastChild(TREENODEVAL(node))));
 518 }
 519
 520 NoAlloc extern "C"  value caml_xml_tree_next_sibling(value tree, value node){
 521   return (Val_int(XMLTREE(tree)->NextSibling(TREENODEVAL(node))));
 522 }
 523
 524 NoAlloc extern "C"  value caml_xml_tree_next_element(value tree, value node){
 525   return (Val_int(XMLTREE(tree)->NextElement(TREENODEVAL(node))));
 526 }
 527
 528 NoAlloc extern "C"  value caml_xml_tree_prev_sibling(value tree, value node){
 529   return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node))));
 530 }
 531
 532 NoAlloc extern "C"  value caml_xml_tree_tagged_child(value tree, value node,value tag){
 533   return (Val_int(XMLTREE(tree)->TaggedChild(TREENODEVAL(node),TAGVAL(tag))));
 534 }
 535
 536 NoAlloc extern "C"  value caml_xml_tree_select_child(value tree, value node,value tags){
 537   return (Val_int(XMLTREE(tree)->SelectChild(TREENODEVAL(node), HSET(tags))));
 538 }
 539
 540 NoAlloc extern "C"  value caml_xml_tree_tagged_following_sibling(value tree, value node,value tag){
 541   return (Val_int(XMLTREE(tree)->TaggedFollowingSibling(TREENODEVAL(node),TAGVAL(tag))));
 542 }
 543
 544 NoAlloc extern "C"  value caml_xml_tree_select_following_sibling(value tree, value node,value tags){
 545   return (Val_int(XMLTREE(tree)->SelectFollowingSibling(TREENODEVAL(node), HSET(tags))));
 546 }
 547
 548 NoAlloc extern "C"  value caml_xml_tree_tagged_descendant(value tree, value node, value tag){
 549   return (Val_int(XMLTREE(tree)->TaggedDescendant(TREENODEVAL(node), TAGVAL(tag))));
 550 }
 551
 552 NoAlloc extern "C"  value caml_xml_tree_select_descendant(value tree, value node, value tags){
 553   return (Val_int(XMLTREE(tree)->SelectDescendant(TREENODEVAL(node), HSET(tags))));
 554 }
 555
 556 NoAlloc extern "C"  value caml_xml_tree_tagged_preceding(value tree, value node, value tag){
 557   return (Val_int(XMLTREE(tree)->TaggedPreceding(TREENODEVAL(node), TAGVAL(tag))));
 558 }
 559
 560 NoAlloc extern "C"  value caml_xml_tree_tagged_following(value tree, value node, value tag){
 561   return (Val_int(XMLTREE(tree)->TaggedFollowing(TREENODEVAL(node), TAGVAL(tag))));
 562 }
 563
 564 NoAlloc extern "C"  value caml_xml_tree_tagged_following_below(value tree, value node, value tag, value ancestor){
 565   return (Val_int(XMLTREE(tree)->TaggedFollowingBelow(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(ancestor))));
 566 }
 567
 568 NoAlloc extern "C"  value caml_xml_tree_select_following_below(value tree, value node, value tags, value ancestor){
 569   return (Val_int(XMLTREE(tree)->SelectFollowingBelow(TREENODEVAL(node), HSET(tags), TREENODEVAL(ancestor))));
 570 }
 571
 572 NoAlloc extern "C"  value caml_xml_tree_tagged_following_before(value tree, value node, value tag, value closing){
 573   return (Val_int(XMLTREE(tree)->TaggedFollowingBefore(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(closing))));
 574 }
 575
 576 NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree, value node, value tags, value closing){
 577   return (Val_int(XMLTREE(tree)->SelectFollowingBefore(TREENODEVAL(node), HSET(tags), TREENODEVAL(closing))));
 578 }
 579
 580 NoAlloc extern "C"  value caml_xml_tree_tagged_ancestor(value tree, value node, value tag){
 581   return (Val_int(XMLTREE(tree)->TaggedAncestor(TREENODEVAL(node), TAGVAL(tag))));
 582 }
 583
 584 NoAlloc extern "C"  value caml_xml_tree_my_text(value tree, value node){
 585   return (Val_int(XMLTREE(tree)->MyText(TREENODEVAL(node))));
 586 }
 587
 588 NoAlloc extern "C"  value caml_xml_tree_my_text_unsafe(value tree, value node){
 589   return (Val_int(XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(node))));
 590 }
 591
 592 NoAlloc extern "C"  value caml_xml_tree_text_xml_id(value tree, value docid){
 593   return (Val_int(XMLTREE(tree)->TextXMLId(Int_val(docid))));
 594 }
 595
 596 NoAlloc extern "C"  value caml_xml_tree_node_xml_id(value tree, value node){
 597   return (Val_int(XMLTREE(tree)->NodeXMLId(TREENODEVAL(node))));
 598 }
 599
 600 NoAlloc extern "C"  value caml_xml_tree_parent_node(value tree, value docid){
 601   return (Val_int(XMLTREE(tree)->ParentNode(Int_val(docid))));
 602 }
 603 /*
 604 NoAlloc extern "C"  value caml_xml_tree_prev_node(value tree, value docid){
 605   return (Val_int(XMLTREE(tree)->PrevNode(Int_val(docid))));
 606 }
 607 */
 608 extern "C"  value caml_xml_tree_get_tag_id(value tree, value tagname){
 609   CAMLparam2(tree,tagname);
 610   CAMLlocal1(res);
 611   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
 612   res = Val_int(XMLTREE(tree)->GetTagId(ctagname));
 613   free(ctagname);
 614   CAMLreturn(res);
 615 }
 616
 617 extern "C"  value caml_xml_tree_get_tag_name(value tree, value tag){
 618   CAMLparam2(tree,tag);
 619   CAMLlocal1(res);
 620   res = caml_copy_string((const char*) XMLTREE(tree)->GetTagNameByRef(TAGVAL(tag)));
 621   CAMLreturn(res);
 622 }
 623
 624 extern "C"  value caml_xml_tree_register_tag(value tree, value tagname){
 625   CAMLparam2(tree,tagname);
 626   CAMLlocal1(res);
 627   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
 628   res = Val_int(XMLTREE(tree)->RegisterTag(ctagname));
 629   free(ctagname);
 630   CAMLreturn(res);
 631 }
 632
 633
 634 NoAlloc extern "C"  value caml_xml_tree_get_text_collection(value tree){
 635   return((value) XMLTREE(tree)->getTextCollection());
 636 }
 637
 638 NoAlloc extern "C"  value caml_xml_tree_closing(value tree, value node){
 639   return (Val_int(XMLTREE(tree)->Closing(TREENODEVAL(node))));
 640 }
 641
 642 NoAlloc extern "C"  value caml_xml_tree_is_open(value tree, value node){
 643   return (Val_bool(XMLTREE(tree)->IsOpen(TREENODEVAL(node))));
 644 }
 645
 646
 647
 648 NoAlloc extern "C"  value caml_xml_tree_nullt(value unit){
 649   return (NULLT);
 650 }
 651
 652 NoAlloc extern "C"  value caml_unordered_set_length(value hset){
 653   return (Val_int((HSET(hset))->size()));
 654 }
 655
 656 extern "C"  value caml_unordered_set_alloc(value unit){
 657   CAMLparam1(unit);
 658   CAMLlocal1(hset);
 659   hset = caml_alloc_custom(&set_ops,sizeof(TagIdSet*),1,2);
 660   TagIdSet* ht = new TagIdSet();
 661   memcpy(Data_custom_val(hset),&ht,sizeof(TagIdSet*));
 662   CAMLreturn (hset);
 663 }
 664
 665 NoAlloc extern "C"  value caml_unordered_set_set(value set, value v){
 666   HSET(set)->insert((int) Int_val(v));
 667   return (Val_unit);
 668 }
 669
 670 NoAlloc extern "C" value caml_result_set_create(value size){
 671   results* res = (results*) malloc(sizeof(results));
 672   results r = createResults (Int_val(size));
 673   res->n = r.n;
 674   res->lgn = r.lgn;
 675   res->tree = r.tree;
 676   return ((value) (res));
 677 }
 678
 679 NoAlloc extern "C"  value caml_result_set_set(value result,value p){
 680   setResult (  *((results*) result), Int_val(p));
 681   return (Val_unit);
 682 }
 683
 684 NoAlloc extern "C"  value caml_result_set_clear(value result,value p1,value p2){
 685   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
 686   return (Val_unit);
 687 }
 688
 689 NoAlloc extern "C"  value caml_result_set_next(value result,value p){
 690   results r;
 691   r = *( (results *) result);
 692   return (Val_int(nextResult(r, Int_val(p))));
 693 }
 694
 695 NoAlloc extern "C" value caml_result_set_count(value result){
 696   results r;
 697   r = *( (results *) result);
 698   return (Val_int(countResult(r)));
 699 }
 700
 701 NoAlloc extern "C"  value caml_xml_tree_print(value tree,value node,value fd){
 702   CAMLparam3(tree,node,fd);
 703   XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node), false);
 704   CAMLreturn(Val_unit);
 705 }
 706
 707 NoAlloc extern "C" value caml_set_tag_bits(value result, value tag, value tree, value node)
 708 {
 709   results r;
 710   XMLTree *t = XMLTREE(Field(tree,0));
 711   treeNode opening = TREENODEVAL(node);
 712   treeNode closing = t->Closing(opening);
 713   TagType target_tag = Int_val(tag);
 714   treeNode first = t->TaggedDescendant(opening,target_tag);
 715   r = *( (results *) result);
 716   opening = first;
 717   while (opening != NULLT){
 718     setResult(r,opening);
 719     opening = t->TaggedFollowingBefore(opening,target_tag,closing);
 720   };
 721   return(Val_int(first));
 722 }
 723
 724
 725 NoAlloc extern "C" value caml_bit_vector_create(value size){
 726   return (value) (new vector<bool>(Int_val(size),false));
 727 }
 728
 729 NoAlloc extern "C" value caml_bit_vector_free(value vect){
 730   delete ((vector<bool>*) vect);
 731   return Val_unit;
 732 }
 733
 734 NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){
 735   return Val_bool (((vector<bool>*)vect)->at(Int_val(idx)));
 736 }
 737
 738 NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){
 739   (((vector<bool>*)vect)->at(Int_val(idx))) = (bool) Bool_val(b);
 740   return Val_unit;
 741 }
 742
 743 NoAlloc extern "C" value caml_bit_vector_next(value vect,value idx){
 744   vector<bool>* bv = (vector<bool>*) vect;
 745   int i = Int_val(idx);
 746   int l = bv->size();
 747   while (i < l && !((*bv)[i]))
 748     i++;
 749   return Val_int(i);
 750 }
 751 NoAlloc extern "C" value caml_bit_vector_prev(value vect,value idx){
 752   int i = Int_val(idx);
 753   while (i >= 0 && !((*((vector<bool>*) vect))[i]))
 754     i--;
 755   return Val_int(i);
 756 }
 757
 758 extern "C" value caml_bit_vector_node_array(value vect){
 759   CAMLparam0();
 760   CAMLlocal1(res);
 761   vector<bool>* bv = (vector<bool>*) vect;
 762   vector<treeNode> vr;
 763   int l = bv->size();
 764   int i = 0;
 765   while (i < l){
 766     if ((*bv)[i]) vr.push_back(i);
 767     i++;
 768   };
 769   l = vr.size();
 770   res = caml_alloc_tuple(l);
 771   for(i=0;i<l;i++)
 772     caml_initialize(&Field(res,i),Val_int(vr[i]));
 773   CAMLreturn (res);
 774 }
 775
 776
 777 int iterjump(XMLTree* tree, treeNode node, TagType tag, treeNode anc){
 778   if (node == NULLT)
 779     return 0;
 780   else {
 781     return
 782       1
 783       + iterjump(tree,tree->TaggedDescendant(node,tag),tag,node)
 784       + iterjump(tree,tree->TaggedFollowingBelow(node,tag,anc),tag,anc);
 785   };
 786 }
 787
 788 extern "C" value caml_benchmark_jump(value tree,value tag){
 789   int count;
 790   treeNode root = XMLTREE(tree)->FirstChild(0);
 791   root = XMLTREE(tree)->FirstChild(root);
 792   count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
 793   return Val_int(count);
 794 }
 795
 796 int iterfcns(XMLTree* tree, treeNode node){
 797   if (node == NULLT)
 798     return 0;
 799   else {
 800     int tmp = 1;
 801     tmp += iterfcns(tree,tree->FirstChild(node));
 802     tmp += iterfcns(tree,tree->NextSibling(node));
 803     return tmp;
 804   };
 805 }
 806
 807 int iterfene(XMLTree* tree, treeNode node){
 808   if (node == NULLT)
 809     return 0;
 810   else {
 811     int tmp = 1;
 812     tmp += iterfene(tree,tree->FirstElement(node));
 813     tmp += iterfene(tree,tree->NextElement(node));
 814     return tmp;
 815   };
 816 }
 817
 818 extern "C" value caml_benchmark_fcns(value tree){
 819   int i = iterfcns(XMLTREE(tree),0);
 820   return Val_int(i);
 821
 822 }
 823
 824 extern "C" value caml_benchmark_fene(value tree){
 825   int i = iterfene(XMLTREE(tree),0);
 826   return Val_int(i);
 827
 828 }
 829
 830 int iterlcps(XMLTree* tree, treeNode node){
 831   if (node == NULLT)
 832     return 0;
 833   else {
 834     int x = tree->Tag(node);
 835     x += iterlcps(tree,tree->LastChild(node));
 836     x += iterlcps(tree,tree->PrevSibling(node));
 837     return x;
 838   };
 839 }
 840
 841 int fulliterative(XMLTree* tree){
 842   treeNode current = tree->Root();
 843   treeNode next = NULLT;
 844   int count = 1; //the root
 845
 846   do {
 847
 848
 849     while ((next = tree->FirstChild(current)) != NULLT) {
 850       current = next;
 851       count++;
 852     };
 853
 854     while ( (next = tree->NextSibling(current)) == NULLT){
 855       current = tree->Parent(current);
 856       if (current == NULLT) return count;
 857     }
 858     current = next;
 859     count++;
 860   } while (true);
 861
 862 }
 863
 864 extern "C" value caml_benchmark_iter(value tree){
 865   return Val_int(fulliterative(XMLTREE(tree)));
 866 }
 867
 868 extern "C" value caml_benchmark_lcps(value tree){
 869   iterlcps(XMLTREE(tree),0);
 870   return Val_unit;
 871
 872 }
 873
 874 extern "C" {
 875
 876   typedef struct dummy_node_ {
 877     struct dummy_node_* first;
 878     struct dummy_node_* next;
 879   } dummy_node;
 880
 881
 882   dummy_node * new_dummy_node () {
 883
 884     dummy_node * node = (dummy_node*) malloc(sizeof(dummy_node));
 885     if (!node)
 886       printf("%s","Cannot allocate memory\n");
 887
 888     return node;
 889   }
 890
 891   void free_tree(dummy_node * node){
 892     if (node){
 893       free_tree(node->first);
 894       free_tree(node->next);
 895       free(node);
 896     };
 897     return;
 898   }
 899
 900   dummy_node * create_tree(XMLTree* tree, treeNode i, int mode){
 901     if (i == NULLT)
 902        return NULL;
 903     else {
 904       dummy_node * f, *n, *r;
 905       //mode = i % 3;
 906       if (mode == 0) r = new_dummy_node();
 907       f = create_tree(tree,tree->FirstChild(i), mode);
 908       if (mode == 1) r = new_dummy_node();
 909       n = create_tree(tree,tree->NextSibling(i), mode);
 910       if (mode == 2) r = new_dummy_node();
 911       r->first = f;
 912       r->next = n;
 913       return r;
 914     };
 915   }
 916
 917   int iter_tree(dummy_node * n){
 918     if (n == NULL)
 919       return 0;
 920     else
 921       return 1 + iter_tree (n->first) + iter_tree (n->next);
 922   }
 923 }
 924 extern "C" value caml_build_pointers(value tree, value mode){
 925   return ((value) create_tree(XMLTREE(Field(tree,0)),0, Int_val(mode)));
 926 }
 927
 928 extern "C" value caml_iter_pointers (value node){
 929   return Val_int(iter_tree((dummy_node*) node));
 930
 931 }
 932
 933 extern "C" value caml_free_pointers(value node){
 934   free_tree((dummy_node*) node);
 935   return Val_unit;
 936 }