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