OCamlDriver.cpp

   1 /**************************************
   2  * OCamlDriver.cpp
   3  * -------------------
   4  * A Test 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 /* OCaml memory managment */
  12 extern "C" {
  13 #include <caml/mlvalues.h>
  14 #include <caml/alloc.h>
  15 #include <caml/memory.h>
  16 #include <caml/callback.h>
  17 #include <caml/fail.h>
  18 #include <caml/custom.h>
  19
  20
  21 #include <unistd.h>
  22 #include <sys/times.h>
  23 #include <time.h>
  24 #include <sys/stat.h>
  25
  26   struct tms t1;
  27   struct tms t2;
  28   double ticks = (double) sysconf(_SC_CLK_TCK)/1000;
  29
  30   void start_clock() {
  31     times (&t1);
  32   }
  33
  34
  35   double stop_clock() {
  36     times (&t2);
  37     return (t2.tms_utime-t1.tms_utime)/ticks;
  38   }
  39 } //extern C
  40
  41
  42 //#include "TextCollection/TextCollection.h"
  43 #include "XMLDocShredder.h"
  44 #include "XMLTree.h"
  45 #include "Utils.h"
  46
  47 #define CAMLRAISECPP(e) (caml_failwith( ((e).what())))
  48 #define NOT_IMPLEMENTED(s)  (caml_failwith(s))
  49 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
  50 #define TEXTCOLLECTION(x)
  51 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
  52 #define XMLTREE_ROOT 0
  53
  54 extern "C" {
  55   static struct custom_operations ops;
  56   static bool initialized = false;
  57 }
  58 extern "C" void caml_xml_tree_finalize(value tree){
  59   delete XMLTREE(tree);
  60   return;
  61 }
  62
  63 extern "C" void caml_init_ops () {
  64
  65   if (initialized)
  66     return;
  67   ops.identifier = (char*) "XMLTree";
  68   ops.finalize = caml_xml_tree_finalize;
  69   return;
  70 }
  71
  72
  73 extern "C" CAMLprim value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
  74   CAMLparam1(uri);
  75   CAMLlocal1(doc);
  76   char *fn = String_val(uri);
  77   try {
  78     XMLDocShredder shredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
  79   XMLTree * tree;
  80   shredder.processStartDocument(fn);
  81   shredder.parse();
  82   shredder.processEndDocument();
  83   caml_init_ops();
  84   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
  85   tree = (XMLTree *) shredder.storageIfc_->returnDocument();
  86   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
  87   CAMLreturn(doc);
  88   }
  89   catch (const std::exception& e){
  90     CAMLRAISECPP(e);
  91   };
  92
  93 }
  94
  95 extern "C" CAMLprim value caml_call_shredder_string(value data,value sf, value iet, value dtc){
  96   CAMLparam1(data);
  97   CAMLlocal1(doc);
  98   unsigned int ln = string_length(data);
  99   unsigned char *fn = (unsigned char*) String_val(data);
 100
 101   try {
 102     XMLDocShredder shredder(fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));
 103     XMLTree* tree;
 104     shredder.processStartDocument("");
 105     shredder.parse();
 106     shredder.processEndDocument();
 107     caml_init_ops();
 108     doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
 109     tree = (XMLTree *) shredder.storageIfc_->returnDocument();
 110     memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
 111     CAMLreturn(doc);
 112   }
 113   catch (const std::exception& e) {
 114     CAMLRAISECPP(e);
 115   };
 116 }
 117
 118
 119
 120
 121 void traversal_rec(XMLTree* tree, treeNode id){
 122  DocID tid;
 123   if (id == NULLT)
 124     return;
 125   //int tag = tree->Tag(id);
 126    if (id) {
 127         tid = tree->PrevText(id);
 128         char * data = (char *) (tree->getTextCollection())->GetText(tid);
 129         if (tree->IsLeaf(id)){
 130           tid = tree->MyText(id);
 131
 132           data = (char*) (tree->getTextCollection())->GetText(tid);
 133         };
 134
 135         if (tree->NextSibling(id) == NULLT){
 136           tid = tree->NextText(id);
 137           data = (char*) (tree->getTextCollection())->GetText(tid);
 138         };
 139    };
 140    traversal_rec(tree,tree->FirstChild(id));
 141    traversal_rec(tree,tree->NextSibling(id));
 142    return;
 143 }
 144
 145 extern "C" CAMLprim value caml_cpp_traversal(value tree){
 146   CAMLparam1(tree);
 147   traversal_rec(XMLTREE(tree),XMLTREE_ROOT);
 148   CAMLreturn(Val_unit);
 149 }
 150
 151 extern "C" CAMLprim value caml_text_collection_get_text(value tree, value id){
 152   CAMLparam2(tree,id);
 153   CAMLlocal1(str);
 154   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
 155   str = caml_copy_string((const char*)txt);
 156   delete (txt);
 157   CAMLreturn (str);
 158 }
 159
 160 extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
 161   CAMLparam2(tree,id);
 162   CAMLlocal1(str);
 163   char* txt = (char*) XMLTREE(tree)->GetCachedText((DocID) Int_val(id));
 164   str = caml_copy_string(txt);
 165   free(txt);
 166   CAMLreturn (str);
 167 }
 168
 169
 170 extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
 171   CAMLparam2(tree,id);
 172   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
 173 }
 174
 175 extern "C" CAMLprim value caml_text_collection_is_contains(value tree,value str){
 176   CAMLparam2(tree,str);
 177   uchar * cstr = (uchar *) String_val(str);
 178   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
 179 }
 180
 181 extern "C" CAMLprim value caml_text_collection_count_contains(value tree,value str){
 182   CAMLparam2(tree,str);
 183   uchar * cstr = (uchar *) String_val(str);
 184   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
 185
 186 }
 187 extern "C" CAMLprim value caml_text_collection_count(value tree,value str){
 188   CAMLparam2(tree,str);
 189   uchar * cstr = (uchar *) String_val(str);
 190   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
 191   CAMLreturn (Val_unit);
 192
 193 }
 194
 195 extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
 196   CAMLparam2(tree,str);
 197   CAMLlocal1(resarray);
 198   uchar * cstr = (uchar *) String_val(str);
 199   std::vector<DocID> results;
 200   results = XMLTREE(tree)->Contains(cstr);
 201   //free(cstr);
 202   resarray = caml_alloc_tuple(results.size());
 203
 204   for (unsigned int i=0; i<results.size();i++){
 205     caml_initialize(&Field(resarray,i),Val_int(results[i]));
 206   };
 207   CAMLreturn (resarray);
 208 }
 209 extern "C" CAMLprim value caml_text_collection_unsorted_contains(value tree,value str){
 210   CAMLparam2(tree,str);
 211   uchar * cstr = (uchar *) String_val(str);
 212   std::vector<DocID> results;
 213   start_clock();
 214   results = XMLTREE(tree)->Contains(cstr);
 215   double d = stop_clock();
 216   std::cerr << "Internal timing " << d <<" ms\n";
 217   CAMLreturn (Val_unit);
 218 }
 219
 220
 221 extern "C" CAMLprim value caml_xml_tree_root(value tree){
 222   CAMLparam1(tree);
 223   CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
 224 }
 225 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
 226   CAMLparam1(tree);
 227   CAMLreturn((value) XMLTREE(tree)->getTextCollection());
 228 }
 229 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
 230   CAMLparam2(tree,id);
 231   CAMLreturn(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
 232 }
 233 extern "C" CAMLprim value caml_xml_tree_prev_sibling(value tree, value id){
 234   CAMLparam2(tree,id);
 235   CAMLreturn(Val_int (XMLTREE(tree)->PrevSibling(TREENODEVAL(id))));
 236 }
 237
 238 extern "C" CAMLprim value caml_xml_tree_parent_doc(value tree, value id){
 239   CAMLparam2(tree,id);
 240   CAMLreturn(Val_int (XMLTREE(tree)->ParentNode((DocID) Int_val(id))));
 241 }
 242
 243 extern "C" CAMLprim value caml_xml_tree_prev_doc(value tree, value id){
 244   CAMLparam2(tree,id);
 245   CAMLreturn(Val_int (XMLTREE(tree)->PrevNode((DocID) Int_val(id))));
 246 }
 247
 248 extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) {
 249   CAMLparam3(tree,id1,id2);
 250   CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2))));
 251 }
 252
 253 extern "C" CAMLprim value caml_xml_tree_serialize(value tree, value filename){
 254   CAMLparam2(tree,filename);
 255   NOT_IMPLEMENTED("caml_xml_tree_serialize");
 256   CAMLreturn(Val_unit);
 257 }
 258
 259 extern "C" CAMLprim value caml_xml_tree_unserialize(value filename){
 260   CAMLparam1(filename);
 261   NOT_IMPLEMENTED("caml_xml_tree_unserialize");
 262   CAMLreturn(Val_unit);
 263 }
 264
 265 extern "C" CAMLprim value caml_xml_tree_last_child(value tree, value id){
 266   CAMLparam2(tree,id);
 267   CAMLreturn(Val_int (XMLTREE(tree)->LastChild(TREENODEVAL(id))));
 268 }
 269
 270 extern "C" CAMLprim value caml_xml_tree_is_first_child(value tree, value id){
 271   CAMLparam2(tree,id);
 272   CAMLreturn(Val_bool (XMLTREE(tree)->IsFirstChild(TREENODEVAL(id))));
 273 }
 274
 275 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
 276   CAMLparam2(tree,id);
 277   CAMLreturn(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
 278 }
 279
 280 extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
 281   CAMLparam3(tree,id,tag);
 282   CAMLreturn(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
 283 }
 284
 285 extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
 286   CAMLparam3(tree,id,tag);
 287   CAMLreturn(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
 288 }
 289
 290
 291 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
 292   CAMLparam2(tree,id);
 293   CAMLreturn(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
 294 }
 295
 296 extern "C" CAMLprim value caml_xml_tree_tagged_desc(value tree, value id, value tag){
 297   CAMLparam3(tree,id,tag);
 298   CAMLreturn(Val_int (XMLTREE(tree)->TaggedDesc(TREENODEVAL(id),(TagType) Int_val(tag))));
 299 }
 300
 301
 302 extern "C" CAMLprim value caml_xml_tree_tagged_foll(value tree, value id, value tag){
 303   CAMLparam3(tree,id,tag);
 304   CAMLreturn(Val_int (XMLTREE(tree)->TaggedFoll(TREENODEVAL(id),(TagType) Int_val(tag))));
 305 }
 306 extern "C" CAMLprim value caml_xml_tree_tagged_foll_below(value tree, value id, value tag,value root){
 307   CAMLparam4(tree,id,tag,root);
 308   CAMLreturn(Val_int (XMLTREE(tree)->TaggedFollBelow(TREENODEVAL(id),(TagType) Int_val(tag),TREENODEVAL(root))));
 309 }
 310
 311
 312 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
 313   CAMLparam2(tree,id);
 314   CAMLreturn(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 315 }
 316
 317 extern "C" CAMLprim value caml_xml_tree_prev_text(value tree, value id){
 318   CAMLparam2(tree,id);
 319   CAMLreturn(Val_int((XMLTREE(tree)->PrevText(TREENODEVAL(id)))));
 320 }
 321 extern "C" CAMLprim value caml_xml_tree_next_text(value tree, value id){
 322   CAMLparam2(tree,id);
 323   CAMLreturn(Val_int((XMLTREE(tree)->NextText(TREENODEVAL(id)))));
 324 }
 325 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
 326   CAMLparam2(tree,id);
 327   CAMLreturn(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
 328 }
 329
 330 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
 331   CAMLparam2(tree,id);
 332   CAMLreturn(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
 333 }
 334 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
 335   CAMLparam2(tree,id);
 336   CAMLreturn(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
 337 }
 338
 339 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
 340   CAMLparam2(tree,tagid);
 341   CAMLlocal1(str);
 342   char* tag;
 343   tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
 344   str = caml_copy_string((const char*) tag);
 345   CAMLreturn (str);
 346 }
 347
 348
 349 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
 350   CAMLparam2(tree,id);
 351   CAMLreturn (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
 352 }
 353
 354 extern "C" CAMLprim value caml_xml_tree_subtree_tags(value tree,value id,value tag){
 355   CAMLparam3(tree,id,tag);
 356   CAMLreturn (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(id),Int_val(tag))));
 357 }
 358
 359
 360 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
 361   CAMLparam2(tree,str);
 362   CAMLlocal1(id);
 363   unsigned char* tag;
 364   tag = (unsigned char*) (String_val(str));
 365   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
 366   CAMLreturn (id);
 367 }
 368
 369 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
 370   CAMLparam1(unit);
 371   CAMLreturn (NULLT);
 372 }
 373
 374 extern "C" CAMLprim value caml_xml_tree_save(value tree,value filename){
 375   CAMLparam2(tree,filename);
 376   XMLTREE(tree)->Save((unsigned char *) String_val(filename));
 377   CAMLreturn (Val_unit);
 378 }
 379
 380 extern "C" CAMLprim value caml_xml_tree_load(value filename,value samplerate){
 381   CAMLparam2(filename,samplerate);
 382   CAMLlocal1(doc);
 383   XMLTree * tree;
 384   tree = XMLTree::Load((unsigned char *) String_val(filename),Int_val(samplerate));
 385   caml_init_ops();
 386   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
 387   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
 388   CAMLreturn(doc);
 389 }
 390
 391 extern "C" {
 392   static int caml_empty_vector[] = { 0 };
 393 }
 394
 395 extern "C" CAMLprim value caml_int_vector_empty(value unit){
 396   CAMLparam1(unit);
 397   CAMLreturn ((value) caml_empty_vector);
 398 }
 399
 400 extern "C" CAMLprim value caml_int_vector_length(value vec){
 401   CAMLparam1(vec);
 402   CAMLreturn (Val_int( ((int*) caml_empty_vector)[0] ));
 403 }
 404 extern "C" CAMLprim value caml_int_vector_alloc(value len){
 405   CAMLparam1(len);
 406   int * vec = (int *) malloc(sizeof(int)*(Int_val(len)+1));
 407   vec[0] = Int_val(len);
 408   CAMLreturn ((value) vec);
 409 }
 410
 411 extern "C" CAMLprim value caml_int_vector_set(value vec, value i, value v){
 412   CAMLparam3(vec,i,v);
 413   ((int*) vec)[Int_val(i)+1] = Int_val(v);
 414   CAMLreturn (Val_unit);
 415 }
 416
 417
 418 #define VECT(x)  ((int*) (x))
 419 extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
 420   CAMLparam3(tree,node,tags);
 421
 422   CAMLreturn (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
 423                                                   &(VECT(tags)[1]),
 424                                                  VECT(tags)[0])));
 425 }
 426 extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
 427   CAMLparam3(tree,node,tags);
 428
 429   CAMLreturn (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
 430                                                   &(VECT(tags)[1]),
 431                                                   VECT(tags)[0])));
 432 }
 433 extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
 434   CAMLparam3(tree,node,tags);
 435
 436   CAMLreturn (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
 437                                                         &(VECT(tags)[1]),
 438                                                         VECT(tags)[0])));
 439 }
 440 extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
 441   CAMLparam4(tree,node,tags,ctx);
 442
 443   CAMLreturn (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
 444                                                       &(VECT(tags)[1]),
 445                                                       VECT(tags)[0],Int_val(ctx))));
 446 }
 447
 448
 449
 450 /*
 451 extern "C" CAMLprim value caml_xml_tree_select_below(value tree, value node, value ctags, value dtags){
 452   CAMLparam4(tree,node,ctags,dtags);
 453
 454   CAMLreturn (Val_int (
 455                        (XMLTREE(tree)->TaggedBelow(TREENODEVAL(node),
 456                                                    &(VECT(ctags)[1]),
 457                                                    VECT(ctags)[0],
 458                                                    &(VECT(dtags)[1]),
 459                                                    VECT(dtags)[0]))));
 460                                                    }
 461 */
 462 /*
 463 extern "C" CAMLprim value caml_xml_tree_select_next(value tree, value node, value ctags, value ftags,value root){
 464   CAMLparam5(tree,node,ctags,ftags,root);
 465   CAMLreturn (Val_int (
 466                        (XMLTREE(tree)->TaggedNext(TREENODEVAL(node),
 467                                                   &(VECT(ctags)[1]),
 468                                                   VECT(ctags)[0],
 469                                                   &(VECT(ftags)[1]),
 470                                                   VECT(ftags)[0],
 471                                                   TREENODEVAL(root)))));
 472 }
 473 */
 474 /*
 475 extern "C" CAMLprim value caml_xml_tree_select_desc_only(value tree, value node,value dtags){
 476   CAMLparam3(tree,node,dtags);
 477
 478   CAMLreturn (Val_int (
 479                        (XMLTREE(tree)->TaggedDescOnly(TREENODEVAL(node),
 480                                                    &(VECT(dtags)[1]),
 481                                                    VECT(dtags)[0]))));
 482 }
 483
 484 extern "C" CAMLprim value caml_xml_tree_select_foll_only(value tree, value node, value ftags,value root){
 485   CAMLparam4(tree,node,ftags,root);
 486   CAMLreturn (Val_int (
 487                        (XMLTREE(tree)->TaggedFollOnly(TREENODEVAL(node),
 488                                                   &(VECT(ftags)[1]),
 489                                                   VECT(ftags)[0],
 490                                                   TREENODEVAL(root)))));
 491 }
 492
 493 extern "C" CAMLprim value caml_xml_tree_select_desc_or_foll_only(value tree, value node, value ftags,value root){
 494   CAMLparam4(tree,node,ftags,root);
 495   CAMLreturn (Val_int (
 496                        (XMLTREE(tree)->TaggedDescOrFollOnly(TREENODEVAL(node),
 497                                                   &(VECT(ftags)[1]),
 498                                                   VECT(ftags)[0],
 499                                                   TREENODEVAL(root)))));
 500 }
 501 */
 502 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
 503   CAMLparam2(tree,node);
 504   CAMLlocal1(tuple);
 505   tuple = caml_alloc_tuple(2);
 506   range r = (XMLTREE(tree)->DocIds(TREENODEVAL(node)));
 507   caml_initialize(&Field(tuple,0),Val_int(r.min));
 508   caml_initialize(&Field(tuple,1),Val_int(r.max));
 509   CAMLreturn (tuple);
 510 }