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