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