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