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