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