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