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_next_node_before(value tree, value node, value ctx){
 285   return (Val_int(XMLTREE(tree)->NextNodeBefore(TREENODEVAL(node), TREENODEVAL(ctx))));
 286 }
 287
 288 NoAlloc extern "C"  value caml_xml_tree_prev_sibling(value tree, value node){
 289   return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node))));
 290 }
 291
 292 NoAlloc extern "C"  value caml_xml_tree_tagged_child(value tree, value node,value tag){
 293   return (Val_int(XMLTREE(tree)->TaggedChild(TREENODEVAL(node),TAGVAL(tag))));
 294 }
 295
 296 NoAlloc extern "C"  value caml_xml_tree_select_child(value tree, value node,value tags){
 297   return (Val_int(XMLTREE(tree)->SelectChild(TREENODEVAL(node), HSET(tags))));
 298 }
 299
 300 NoAlloc extern "C"  value caml_xml_tree_tagged_following_sibling(value tree, value node,value tag){
 301   return (Val_int(XMLTREE(tree)->TaggedFollowingSibling(TREENODEVAL(node),TAGVAL(tag))));
 302 }
 303
 304 NoAlloc extern "C"  value caml_xml_tree_select_following_sibling(value tree, value node,value tags){
 305   return (Val_int(XMLTREE(tree)->SelectFollowingSibling(TREENODEVAL(node), HSET(tags))));
 306 }
 307
 308 NoAlloc extern "C"  value caml_xml_tree_tagged_descendant(value tree, value node, value tag){
 309   return (Val_int(XMLTREE(tree)->TaggedDescendant(TREENODEVAL(node), TAGVAL(tag))));
 310 }
 311
 312 NoAlloc extern "C"  value caml_xml_tree_tagged_next(value tree, value node, value tag){
 313   return (Val_int(XMLTREE(tree)->TaggedNext(TREENODEVAL(node), TAGVAL(tag))));
 314 }
 315
 316 NoAlloc extern "C"  value caml_xml_tree_select_descendant(value tree, value node, value tags){
 317   return (Val_int(XMLTREE(tree)->SelectDescendant(TREENODEVAL(node), HSET(tags))));
 318 }
 319
 320 NoAlloc extern "C"  value caml_xml_tree_tagged_preceding(value tree, value node, value tag){
 321   return (Val_int(XMLTREE(tree)->TaggedPreceding(TREENODEVAL(node), TAGVAL(tag))));
 322 }
 323
 324 NoAlloc extern "C"  value caml_xml_tree_tagged_following(value tree, value node, value tag){
 325   return (Val_int(XMLTREE(tree)->TaggedFollowing(TREENODEVAL(node), TAGVAL(tag))));
 326 }
 327
 328 NoAlloc extern "C"  value caml_xml_tree_tagged_following_below(value tree, value node, value tag, value ancestor){
 329   return (Val_int(XMLTREE(tree)->TaggedFollowingBelow(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(ancestor))));
 330 }
 331
 332 NoAlloc extern "C"  value caml_xml_tree_select_following_below(value tree, value node, value tags, value ancestor){
 333   return (Val_int(XMLTREE(tree)->SelectFollowingBelow(TREENODEVAL(node), HSET(tags), TREENODEVAL(ancestor))));
 334 }
 335
 336 NoAlloc extern "C"  value caml_xml_tree_tagged_following_before(value tree, value node, value tag, value closing){
 337   return (Val_int(XMLTREE(tree)->TaggedFollowingBefore(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(closing))));
 338 }
 339
 340 NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree, value node, value tags, value closing){
 341   return (Val_int(XMLTREE(tree)->SelectFollowingBefore(TREENODEVAL(node), HSET(tags), TREENODEVAL(closing))));
 342 }
 343
 344 NoAlloc extern "C"  value caml_xml_tree_tagged_ancestor(value tree, value node, value tag){
 345   return (Val_int(XMLTREE(tree)->TaggedAncestor(TREENODEVAL(node), TAGVAL(tag))));
 346 }
 347
 348 NoAlloc extern "C"  value caml_xml_tree_my_text(value tree, value node){
 349   return (Val_int(XMLTREE(tree)->MyText(TREENODEVAL(node))));
 350 }
 351
 352 NoAlloc extern "C"  value caml_xml_tree_my_text_unsafe(value tree, value node){
 353   return (Val_int(XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(node))));
 354 }
 355
 356 NoAlloc extern "C"  value caml_xml_tree_text_xml_id(value tree, value docid){
 357   return (Val_int(XMLTREE(tree)->TextXMLId(Int_val(docid))));
 358 }
 359
 360 NoAlloc extern "C"  value caml_xml_tree_node_xml_id(value tree, value node){
 361   return (Val_int(XMLTREE(tree)->NodeXMLId(TREENODEVAL(node))));
 362 }
 363
 364 NoAlloc extern "C"  value caml_xml_tree_parent_node(value tree, value docid){
 365   return (Val_int(XMLTREE(tree)->ParentNode(Int_val(docid))));
 366 }
 367 /*
 368 NoAlloc extern "C"  value caml_xml_tree_prev_node(value tree, value docid){
 369   return (Val_int(XMLTREE(tree)->PrevNode(Int_val(docid))));
 370 }
 371 */
 372 extern "C"  value caml_xml_tree_get_tag_id(value tree, value tagname){
 373   CAMLparam2(tree,tagname);
 374   CAMLlocal1(res);
 375   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
 376   res = Val_int(XMLTREE(tree)->GetTagId(ctagname));
 377   free(ctagname);
 378   CAMLreturn(res);
 379 }
 380
 381 extern "C"  value caml_xml_tree_get_tag_name(value tree, value tag){
 382   CAMLparam2(tree,tag);
 383   CAMLlocal1(res);
 384   res = caml_copy_string((const char*) XMLTREE(tree)->GetTagNameByRef(TAGVAL(tag)));
 385   CAMLreturn(res);
 386 }
 387
 388 extern "C"  value caml_xml_tree_register_tag(value tree, value tagname){
 389   CAMLparam2(tree,tagname);
 390   CAMLlocal1(res);
 391   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
 392   res = Val_int(XMLTREE(tree)->RegisterTag(ctagname));
 393   free(ctagname);
 394   CAMLreturn(res);
 395 }
 396
 397
 398 NoAlloc extern "C"  value caml_xml_tree_get_text_collection(value tree){
 399   return((value) XMLTREE(tree)->getTextCollection());
 400 }
 401
 402 NoAlloc extern "C"  value caml_xml_tree_closing(value tree, value node){
 403   return (Val_int(XMLTREE(tree)->Closing(TREENODEVAL(node))));
 404 }
 405
 406 NoAlloc extern "C"  value caml_xml_tree_is_open(value tree, value node){
 407   return (Val_bool(XMLTREE(tree)->IsOpen(TREENODEVAL(node))));
 408 }
 409
 410
 411
 412 NoAlloc extern "C"  value caml_xml_tree_nullt(value unit){
 413   return (NULLT);
 414 }
 415
 416
 417 NoAlloc extern "C"  value caml_unordered_set_length(value hset){
 418   return (Val_int((HSET(hset))->size()));
 419 }
 420
 421 extern "C"  value caml_unordered_set_alloc(value unit){
 422   CAMLparam1(unit);
 423   CAMLlocal1(hset);
 424   hset = sxsi_alloc_custom<TagIdSet*>();
 425   Obj_val<TagIdSet*>(hset) = new TagIdSet();
 426   CAMLreturn (hset);
 427 }
 428
 429 NoAlloc extern "C"  value caml_unordered_set_set(value set, value v){
 430   HSET(set)->insert((int) Int_val(v));
 431   return (Val_unit);
 432 }
 433
 434 // NoAlloc extern "C" value caml_result_set_create(value size){
 435 //   results* res = (results*) malloc(sizeof(results));
 436 //   results r = createResults (Int_val(size));
 437 //   res->n = r.n;
 438 //   res->lgn = r.lgn;
 439 //   res->tree = r.tree;
 440 //   return ((value) (res));
 441 // }
 442
 443 // NoAlloc extern "C"  value caml_result_set_set(value result,value p){
 444 //   setResult (  *((results*) result), Int_val(p));
 445 //   return (Val_unit);
 446 // }
 447
 448 // NoAlloc extern "C"  value caml_result_set_clear(value result,value p1,value p2){
 449 //   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
 450 //   return (Val_unit);
 451 // }
 452
 453 // NoAlloc extern "C"  value caml_result_set_next(value result,value p){
 454 //   results r;
 455 //   r = *( (results *) result);
 456 //   return (Val_int(nextResult(r, Int_val(p))));
 457 // }
 458
 459 // NoAlloc extern "C" value caml_result_set_count(value result){
 460 //   results r;
 461 //   r = *( (results *) result);
 462 //   return (Val_int(countResult(r)));
 463 // }
 464
 465 NoAlloc extern "C"  value caml_xml_tree_print(value tree,value node,value fd){
 466   CAMLparam3(tree,node,fd);
 467   XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node), false);
 468   CAMLreturn(Val_unit);
 469 }
 470
 471 NoAlloc extern "C"  value caml_xml_tree_flush(value tree, value fd){
 472   CAMLparam2(tree,fd);
 473   XMLTREE(tree)->Flush(Int_val(fd));
 474   CAMLreturn(Val_unit);
 475 }
 476
 477 // NoAlloc extern "C" value caml_set_tag_bits(value result, value tag, value tree, value node)
 478 // {
 479 //   results r;
 480 //   XMLTree *t = XMLTREE(Field(tree,0));
 481 //   treeNode opening = TREENODEVAL(node);
 482 //   treeNode closing = t->Closing(opening);
 483 //   TagType target_tag = Int_val(tag);
 484 //   treeNode first = t->TaggedDescendant(opening,target_tag);
 485 //   r = *( (results *) result);
 486 //   opening = first;
 487 //   while (opening != NULLT){
 488 //     setResult(r,opening);
 489 //     opening = t->TaggedFollowingBefore(opening,target_tag,closing);
 490 //   };
 491 //   return(Val_int(first));
 492 // }
 493
 494
 495 NoAlloc extern "C" value caml_bit_vector_create(value size){
 496   return (value) (new vector<bool>(Int_val(size),false));
 497 }
 498
 499 NoAlloc extern "C" value caml_bit_vector_free(value vect){
 500   delete ((vector<bool>*) vect);
 501   return Val_unit;
 502 }
 503
 504 NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){
 505   return Val_bool (((vector<bool>*)vect)->at(Int_val(idx)));
 506 }
 507
 508 NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){
 509   (((vector<bool>*)vect)->at(Int_val(idx))) = (bool) Bool_val(b);
 510   return Val_unit;
 511 }
 512
 513 NoAlloc extern "C" value caml_bit_vector_next(value vect,value idx){
 514   vector<bool>* bv = (vector<bool>*) vect;
 515   int i = Int_val(idx);
 516   int l = bv->size();
 517   while (i < l && !((*bv)[i]))
 518     i++;
 519   return Val_int(i);
 520 }
 521 NoAlloc extern "C" value caml_bit_vector_prev(value vect,value idx){
 522   int i = Int_val(idx);
 523   while (i >= 0 && !((*((vector<bool>*) vect))[i]))
 524     i--;
 525   return Val_int(i);
 526 }
 527
 528 extern "C" value caml_bit_vector_node_array(value vect){
 529   CAMLparam0();
 530   CAMLlocal1(res);
 531   vector<bool>* bv = (vector<bool>*) vect;
 532   vector<treeNode> vr;
 533   int l = bv->size();
 534   int i = 0;
 535   while (i < l){
 536     if ((*bv)[i]) vr.push_back(i);
 537     i++;
 538   };
 539   l = vr.size();
 540   res = caml_alloc_tuple(l);
 541   for(i=0;i<l;i++)
 542     caml_initialize(&Field(res,i),Val_int(vr[i]));
 543   CAMLreturn (res);
 544 }
 545
 546
 547 int iterjump(XMLTree* tree, treeNode node, TagType tag, treeNode anc){
 548   if (node == NULLT)
 549     return 0;
 550   else {
 551     return
 552       1
 553       + iterjump(tree,tree->TaggedDescendant(node,tag),tag,node)
 554       + iterjump(tree,tree->TaggedFollowingBelow(node,tag,anc),tag,anc);
 555   };
 556 }
 557
 558 extern "C" value caml_benchmark_jump(value tree,value tag){
 559   int count;
 560   treeNode root = XMLTREE(tree)->FirstChild(0);
 561   root = XMLTREE(tree)->FirstChild(root);
 562   count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
 563   return Val_int(count);
 564 }
 565
 566 int iterfcns(XMLTree* tree, treeNode node){
 567   if (node == NULLT)
 568     return 0;
 569   else {
 570     int tmp = 1;
 571     tmp += iterfcns(tree,tree->FirstChild(node));
 572     tmp += iterfcns(tree,tree->NextSibling(node));
 573
 574     return tmp;
 575   };
 576 }
 577
 578 int iterfene(XMLTree* tree, treeNode node){
 579   if (node == NULLT)
 580     return 0;
 581   else {
 582     int tmp = 1;
 583     tmp += iterfene(tree,tree->FirstElement(node));
 584     tmp += iterfene(tree,tree->NextElement(node));
 585     return tmp;
 586
 587   };
 588 }
 589
 590 extern "C" value caml_benchmark_fcns(value tree){
 591   int i = iterfcns(XMLTREE(tree),0);
 592   return Val_int(i);
 593 }
 594
 595 extern "C" value caml_benchmark_fene(value tree){
 596   int i = iterfene(XMLTREE(tree),0);
 597   return Val_int(i);
 598 }
 599
 600 int iterlcps(XMLTree* tree, treeNode node){
 601   if (node == NULLT)
 602     return 0;
 603   else {
 604     int x = tree->Tag(node);
 605     x += iterlcps(tree,tree->LastChild(node));
 606     x += iterlcps(tree,tree->PrevSibling(node));
 607     return x;
 608   };
 609 }
 610
 611 int fulliterative(XMLTree* tree){
 612   treeNode current = tree->Root();
 613   treeNode next = NULLT;
 614   int count = 1; //the root
 615
 616   do {
 617
 618     while ((next = tree->FirstChild(current)) != NULLT) {
 619       current = next;
 620       count++;
 621     };
 622
 623     while ( (next = tree->NextSibling(current)) == NULLT){
 624       current = tree->Parent(current);
 625       if (current == NULLT) return count;
 626     }
 627     current = next;
 628     count++;
 629   } while (true);
 630
 631 }
 632
 633 extern "C" value caml_benchmark_iter(value tree){
 634   return Val_int(fulliterative(XMLTREE(tree)));
 635 }
 636
 637 extern "C" value caml_benchmark_lcps(value tree){
 638
 639   iterlcps(XMLTREE(tree),0);
 640   return Val_unit;
 641
 642 }
 643
 644 extern "C" {
 645
 646   typedef struct dummy_node_ {
 647     struct dummy_node_* first;
 648     struct dummy_node_* next;
 649   } dummy_node;
 650
 651
 652   dummy_node * new_dummy_node () {
 653
 654     dummy_node * node = (dummy_node*) malloc(sizeof(dummy_node));
 655     if (!node)
 656       printf("%s","Cannot allocate memory\n");
 657
 658     return node;
 659   }
 660
 661   void free_tree(dummy_node * node){
 662     if (node){
 663       free_tree(node->first);
 664       free_tree(node->next);
 665       free(node);
 666     };
 667     return;
 668   }
 669
 670   dummy_node * create_tree(XMLTree* tree, treeNode i, int mode){
 671     if (i == NULLT)
 672        return NULL;
 673     else {
 674       dummy_node * f, *n, *r;
 675       //mode = i % 3;
 676       r = NULL;
 677       if (mode == 0) r = new_dummy_node();
 678       f = create_tree(tree,tree->FirstChild(i), mode);
 679       if (mode == 1) r = new_dummy_node();
 680       n = create_tree(tree,tree->NextSibling(i), mode);
 681       if (mode == 2) r = new_dummy_node();
 682       r->first = f;
 683       r->next = n;
 684       return r;
 685     };
 686   }
 687
 688   int iter_tree(dummy_node * n){
 689     if (n == NULL)
 690       return 0;
 691     else
 692       return 1 + iter_tree (n->first) + iter_tree (n->next);
 693   }
 694 }
 695 extern "C" value caml_build_pointers(value tree, value mode){
 696   return ((value) create_tree(XMLTREE(Field(tree,0)),0, Int_val(mode)));
 697 }
 698
 699 extern "C" value caml_iter_pointers (value node){
 700   return Val_int(iter_tree((dummy_node*) node));
 701
 702 }
 703
 704 extern "C" value caml_free_pointers(value node){
 705   free_tree((dummy_node*) node);
 706   return Val_unit;
 707 }
 708 /**
 709  *  Interface to the TextCollection
 710  */
 711
 712 /**
 713  *  Utility functions
 714  */
 715
 716 extern "C"  value caml_text_collection_get_text(value tree, value id){
 717   CAMLparam2(tree,id);
 718   CAMLlocal1(str);
 719   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
 720   str = caml_copy_string((const char*)txt);
 721   CAMLreturn (str);
 722 }
 723
 724
 725 extern "C"  value caml_text_collection_empty_text(value tree,value id){
 726   CAMLparam2(tree,id);
 727   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
 728 }
 729
 730 bool docId_comp(DocID x, DocID y) { return x < y; }
 731
 732 /**
 733  * Existential queries
 734  */
 735
 736 extern "C"  value caml_text_collection_is_prefix(value tree,value str){
 737   CAMLparam2(tree,str);
 738   uchar * cstr = (uchar *) String_val(str);
 739   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsPrefix(cstr)));
 740 }
 741
 742 extern "C"  value caml_text_collection_is_suffix(value tree,value str){
 743   CAMLparam2(tree,str);
 744   uchar * cstr = (uchar *) String_val(str);
 745   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsSuffix(cstr)));
 746 }
 747 extern "C"  value caml_text_collection_is_equal(value tree,value str){
 748   CAMLparam2(tree,str);
 749   uchar * cstr = (uchar *) String_val(str);
 750   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsEqual(cstr)));
 751 }
 752 extern "C"  value caml_text_collection_is_contains(value tree,value str){
 753   CAMLparam2(tree,str);
 754   uchar * cstr = (uchar *) String_val(str);
 755   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
 756 }
 757
 758 extern "C"  value caml_text_collection_is_lessthan(value tree,value str){
 759   CAMLparam2(tree,str);
 760   uchar * cstr = (uchar *) String_val(str);
 761   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsLessThan(cstr)));
 762 }
 763
 764
 765 /**
 766  * Count Queries
 767  */
 768
 769 /**
 770  *  Global counting
 771  */
 772 extern "C"  value caml_text_collection_count(value tree,value str){
 773   CAMLparam2(tree,str);
 774   uchar * cstr = (uchar *) String_val(str);
 775   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
 776 }
 777
 778 extern "C"  value caml_text_collection_count_prefix(value tree,value str){
 779   CAMLparam2(tree,str);
 780   uchar * cstr = (uchar *) String_val(str);
 781   CAMLreturn (Val_int((XMLTREE(tree)->CountPrefix(cstr))));
 782 }
 783
 784 extern "C"  value caml_text_collection_count_suffix(value tree,value str){
 785   CAMLparam2(tree,str);
 786   uchar * cstr = (uchar *) String_val(str);
 787   CAMLreturn (Val_int((XMLTREE(tree)->CountSuffix(cstr))));
 788 }
 789
 790 extern "C"  value caml_text_collection_count_equal(value tree,value str){
 791   CAMLparam2(tree,str);
 792   uchar * cstr = (uchar *) String_val(str);
 793   CAMLreturn (Val_int((XMLTREE(tree)->CountEqual(cstr))));
 794 }
 795
 796 extern "C"  value caml_text_collection_count_contains(value tree,value str){
 797   CAMLparam2(tree,str);
 798   uchar * cstr = (uchar *) String_val(str);
 799   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
 800 }
 801
 802 extern "C"  value caml_text_collection_count_lessthan(value tree,value str){
 803   CAMLparam2(tree,str);
 804   uchar * cstr = (uchar *) String_val(str);
 805   CAMLreturn (Val_int((XMLTREE(tree)->CountLessThan(cstr))));
 806 }
 807
 808 static value sort_alloc_array(std::vector<DocID> results, value resarray){
 809   std::sort(results.begin(), results.end(), docId_comp);
 810     size_t s = results.size();
 811     resarray = caml_alloc_tuple(s);
 812     for (size_t i = 0; i < s ;i++){
 813       caml_initialize(&Field(resarray,i),Val_int(results[i]));
 814     };
 815     return resarray;
 816
 817 }
 818
 819 /**
 820  * Full reporting queries
 821  */
 822
 823 extern "C"  value caml_text_collection_prefix(value tree,value str){
 824   CAMLparam2(tree,str);
 825   CAMLlocal1(resarray);
 826   uchar * cstr = (uchar *) String_val(str);
 827   std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
 828   CAMLreturn (sort_alloc_array(results,resarray));
 829 }
 830
 831 extern "C"  value caml_text_collection_suffix(value tree,value str){
 832   CAMLparam2(tree,str);
 833   CAMLlocal1(resarray);
 834   uchar * cstr = (uchar *) String_val(str);
 835   std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
 836   CAMLreturn (sort_alloc_array(results,resarray));
 837 }
 838
 839 extern "C"  value caml_text_collection_equals(value tree,value str){
 840   CAMLparam2(tree,str);
 841   CAMLlocal1(resarray);
 842   uchar * cstr = (uchar *) strdup(String_val(str));
 843   std::vector<DocID> results = XMLTREE(tree)->Equals(cstr);
 844   free(cstr);
 845   CAMLreturn (sort_alloc_array(results,resarray));
 846 }
 847
 848 extern "C"  value caml_text_collection_contains(value tree,value str){
 849   CAMLparam2(tree,str);
 850   CAMLlocal1(resarray);
 851   uchar * cstr = (uchar *) String_val(str);
 852   std::vector<DocID> results = XMLTREE(tree)->Contains(cstr);
 853   CAMLreturn (sort_alloc_array(results,resarray));
 854 }
 855
 856 extern "C"  value caml_text_collection_lessthan(value tree,value str){
 857   CAMLparam2(tree,str);
 858   CAMLlocal1(resarray);
 859   uchar * cstr = (uchar *) String_val(str);
 860   std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
 861   CAMLreturn (sort_alloc_array(results,resarray));
 862 }
 863
 864 /** Full reporting into a bit vector
 865  */
 866
 867 #define BV_QUERY(pref, Pref) \
 868   extern "C" value caml_text_collection_## pref ##_bv(value tree, value str){ \
 869   CAMLparam2(tree, str);                                                \
 870   CAMLlocal3(res, res_bv, res_array);                                   \
 871   int j;                                                                \
 872   uchar * cstr = (uchar *) strdup(String_val(str));                     \
 873   std::vector<DocID> results = XMLTREE(tree)->Pref(cstr);               \
 874   res_bv = caml_alloc_string((XMLTREE(tree)->Size() / 4) + 2);          \
 875   unsigned long slen = caml_string_length(res_bv);                      \
 876   memset(&(Byte(res_bv,0)), 0, slen);                                   \
 877   res_array = caml_alloc_shr(results.size(), 0);                        \
 878   for (unsigned int i = 0; i < results.size(); ++i) {                   \
 879     j = XMLTREE(tree)->ParentNode(results[i]);                          \
 880     Byte(res_bv, j >> 3) |=   (1 << (j & 7));                           \
 881     caml_initialize(&Field(res_array, i), Val_int(j));                  \
 882   };                                                                    \
 883   free(cstr);                                                           \
 884   res = caml_alloc(2, 0);                                               \
 885   Store_field(res, 0, res_bv);                                          \
 886   Store_field(res, 1, res_array);                                       \
 887   CAMLreturn(res);                                                      \
 888   }                                                                     \
 889
 890
 891 BV_QUERY(prefix, Prefix)
 892 BV_QUERY(suffix, Suffix)
 893 BV_QUERY(equals, Equals)
 894 BV_QUERY(contains, Contains)
 895 BV_QUERY(lessthan, LessThan)