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