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