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