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
  13 #include <unordered_set>
  14 #include <algorithm>
  15 #include "XMLDocShredder.h"
  16 #include "XMLTree.h"
  17 #include "Utils.h"
  18
  19 extern "C" {
  20 /* OCaml memory managment */
  21 #include <caml/mlvalues.h>
  22 #include <caml/alloc.h>
  23 #include <caml/memory.h>
  24 #include <caml/callback.h>
  25 #include <caml/fail.h>
  26 #include <caml/custom.h>
  27 #include "results.h"
  28
  29 #define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) ))
  30 #define NOT_IMPLEMENTED(s)  (caml_failwith(s))
  31 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
  32 #define HSET(x) ((std::unordered_set<int>*)((* (std::unordered_set<int>**) Data_custom_val(x))))
  33 #define TEXTCOLLECTION(x)
  34 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
  35 #define XMLTREE_ROOT 0
  36
  37   static struct custom_operations ops;
  38   static struct custom_operations set_ops;
  39   static value * cpp_exception = NULL;
  40   static bool ops_initialized = false;
  41
  42 }
  43
  44 extern "C" void caml_xml_tree_finalize(value tree){
  45   delete XMLTREE(tree);
  46   return;
  47 }
  48
  49 extern "C" void caml_hset_finalize(value hblock){
  50   delete HSET(hblock);
  51   return;
  52 }
  53
  54 extern "C" CAMLprim value caml_init_lib (value unit) {
  55   CAMLparam1(unit);
  56   if (!ops_initialized){
  57
  58
  59   ops.identifier = (char*) "XMLTree";
  60   ops.finalize = caml_xml_tree_finalize;
  61   set_ops.identifier = (char*) "unordered_set";
  62   set_ops.finalize = caml_hset_finalize;
  63
  64   cpp_exception = caml_named_value("CPlusPlusError");
  65   if (cpp_exception == NULL){
  66     string s = "FATAL: Unregistered exception ";
  67     s += "CPlusPlusError";
  68     caml_failwith(s.c_str());
  69   };
  70
  71   ops_initialized = true;
  72
  73   };
  74   CAMLreturn(Val_unit);
  75
  76 }
  77 extern "C" CAMLprim value caml_shredder_parse(XMLDocShredder *shredder){
  78   CAMLparam0();
  79   CAMLlocal1(doc);
  80   XMLTree * tree;
  81   shredder->processStartDocument("");
  82   shredder->parse();
  83   shredder->processEndDocument();
  84   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
  85   tree = (XMLTree *) shredder->getXMLTree();
  86   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
  87   CAMLreturn(doc);
  88
  89 }
  90
  91 extern "C" CAMLprim value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
  92   CAMLparam1(uri);
  93   CAMLlocal1(doc);
  94   char *fn = String_val(uri);
  95   XMLDocShredder * shredder;
  96   try {
  97     shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
  98     doc = caml_shredder_parse(shredder);
  99     delete shredder;
 100   }
 101   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 102   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 103   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 104   CAMLreturn (doc);
 105
 106 }
 107 extern "C" CAMLprim value caml_call_shredder_string(value data,value sf, value iet, value dtc){
 108   CAMLparam1(data);
 109   CAMLlocal1(doc);
 110   XMLDocShredder * shredder;
 111   unsigned int ln = string_length(data);
 112   unsigned char *fn = (unsigned char*) String_val(data);
 113   try {
 114     shredder = new  XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));
 115     doc = caml_shredder_parse(shredder);
 116     delete shredder;
 117   }
 118   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 119   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 120   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 121   CAMLreturn(doc);
 122 }
 123
 124 extern "C" CAMLprim value caml_xml_tree_save(value tree,value fd){
 125   CAMLparam2(tree,fd);
 126   XMLTREE(tree)->Save(Int_val(fd));
 127   CAMLreturn (Val_unit);
 128 }
 129
 130 extern "C" CAMLprim value caml_xml_tree_load(value fd){
 131   CAMLparam1(fd);
 132   CAMLlocal1(doc);
 133   XMLTree * tree;
 134   try {
 135   tree = XMLTree::Load(Int_val(fd));
 136   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
 137   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
 138   CAMLreturn(doc);
 139   }
 140   catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); }
 141   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 142   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 143   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 144 }
 145
 146
 147
 148 extern "C" CAMLprim value caml_text_collection_get_text(value tree, value id){
 149   CAMLparam2(tree,id);
 150   CAMLlocal1(str);
 151   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
 152   str = caml_copy_string((const char*)txt);
 153   CAMLreturn (str);
 154 }
 155
 156 extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
 157   CAMLparam2(tree,id);
 158   CAMLlocal1(str);
 159   char* txt = (char*) XMLTREE(tree)->GetText((DocID) Int_val(id));
 160   str = caml_copy_string(txt);
 161   CAMLreturn (str);
 162 }
 163
 164
 165 extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
 166   CAMLparam2(tree,id);
 167   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
 168 }
 169
 170 extern "C" CAMLprim value caml_text_collection_is_contains(value tree,value str){
 171   CAMLparam2(tree,str);
 172   uchar * cstr = (uchar *) String_val(str);
 173   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
 174 }
 175
 176 extern "C" CAMLprim value caml_text_collection_count_contains(value tree,value str){
 177   CAMLparam2(tree,str);
 178   uchar * cstr = (uchar *) String_val(str);
 179   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
 180
 181 }
 182 extern "C" CAMLprim value caml_text_collection_count(value tree,value str){
 183   CAMLparam2(tree,str);
 184   uchar * cstr = (uchar *) String_val(str);
 185   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
 186   CAMLreturn (Val_unit);
 187
 188 }
 189 bool docId_comp(DocID x, DocID y) { return x < y; };
 190
 191 extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
 192   CAMLparam2(tree,str);
 193   CAMLlocal1(resarray);
 194   uchar * cstr = (uchar *) String_val(str);
 195   std::vector<DocID> results;
 196   results = XMLTREE(tree)->Contains(cstr);
 197   //free(cstr);
 198   std::sort(results.begin(), results.end(), docId_comp);
 199   size_t s = results.size();
 200   resarray = caml_alloc_tuple(s);
 201
 202   for (size_t i = 0; i < s ;i++){
 203     caml_initialize(&Field(resarray,i),Val_int(results[i]));
 204   };
 205   CAMLreturn (resarray);
 206 }
 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   results = XMLTREE(tree)->Contains(cstr);
 213   CAMLreturn (Val_unit);
 214 }
 215
 216
 217 extern "C" CAMLprim value caml_xml_tree_root(value tree){
 218   CAMLparam1(tree);
 219   CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
 220 }
 221 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
 222   CAMLparam1(tree);
 223   CAMLreturn((value) XMLTREE(tree)->getTextCollection());
 224 }
 225 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
 226   return(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
 227 }
 228 extern "C" CAMLprim value caml_xml_tree_prev_sibling(value tree, value id){
 229   return(Val_int (XMLTREE(tree)->PrevSibling(TREENODEVAL(id))));
 230 }
 231
 232 extern "C" CAMLprim value caml_xml_tree_parent_doc(value tree, value id){
 233   return (Val_int (XMLTREE(tree)->ParentNode((DocID) Int_val(id))));
 234 }
 235
 236 extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) {
 237   CAMLparam3(tree,id1,id2);
 238   CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2))));
 239 }
 240
 241 extern "C" CAMLprim value caml_xml_tree_last_child(value tree, value id){
 242   return(Val_int (XMLTREE(tree)->LastChild(TREENODEVAL(id))));
 243 }
 244
 245 extern "C" CAMLprim value caml_xml_tree_is_first_child(value tree, value id){
 246   return Val_bool (XMLTREE(tree)->IsFirstChild(TREENODEVAL(id)));
 247 }
 248 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
 249   return(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
 250 }
 251 extern "C" CAMLprim value caml_xml_tree_closing(value tree, value id){
 252   return(Val_int (XMLTREE(tree)->Closing(TREENODEVAL(id))));
 253 }
 254 extern "C" CAMLprim value caml_xml_tree_is_open(value tree, value id){
 255   return(Val_bool (XMLTREE(tree)->IsOpen(TREENODEVAL(id))));
 256 }
 257
 258 extern "C" CAMLprim value caml_xml_tree_first_element(value tree, value id){
 259   return(Val_int (XMLTREE(tree)->FirstElement(TREENODEVAL(id))));
 260 }
 261
 262 extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
 263   return(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
 264 }
 265
 266 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
 267   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 268 }
 269
 270 extern "C" CAMLprim value caml_xml_tree_next_element(value tree, value id){
 271   return(Val_int (XMLTREE(tree)->NextElement(TREENODEVAL(id))));
 272 }
 273
 274 extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
 275   return(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
 276 }
 277
 278
 279 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
 280   return(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
 281 }
 282
 283 extern "C" CAMLprim value caml_xml_tree_tagged_desc(value tree, value id, value tag){
 284   return(Val_int (XMLTREE(tree)->TaggedDesc(TREENODEVAL(id),(TagType) Int_val(tag))));
 285 }
 286
 287
 288 extern "C" CAMLprim value caml_xml_tree_tagged_foll(value tree, value id, value tag){
 289   return(Val_int (XMLTREE(tree)->TaggedFoll(TREENODEVAL(id),(TagType) Int_val(tag))));
 290 }
 291 extern "C" CAMLprim value caml_xml_tree_tagged_foll_below(value tree, value id, value tag,value root){
 292   return(Val_int (XMLTREE(tree)->TaggedFollBelow(TREENODEVAL(id),(TagType) Int_val(tag),TREENODEVAL(root))));
 293 }
 294
 295 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
 296   return(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
 297 }
 298
 299 extern "C" CAMLprim value caml_xml_tree_my_text_unsafe(value tree, value id){
 300   return(Val_int((XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(id)))));
 301 }
 302
 303 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
 304   return(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
 305 }
 306 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
 307   return(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
 308 }
 309
 310 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
 311   CAMLparam2(tree,tagid);
 312   CAMLlocal1(str);
 313   char* tag;
 314   tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
 315   str = caml_copy_string((const char*) tag);
 316   CAMLreturn (str);
 317 }
 318
 319
 320 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
 321   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
 322 }
 323
 324 extern "C" CAMLprim value caml_xml_tree_subtree_tags(value tree,value id,value tag){
 325   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(id),Int_val(tag))));
 326 }
 327
 328 extern "C" CAMLprim value caml_xml_tree_subtree_size(value tree,value id){
 329   return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(id))));
 330 }
 331
 332 extern "C" CAMLprim value caml_xml_tree_subtree_elements(value tree,value id){
 333   return (Val_int(XMLTREE(tree)->SubtreeElements(TREENODEVAL(id))));
 334 }
 335
 336
 337 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
 338   CAMLparam2(tree,str);
 339   CAMLlocal1(id);
 340   unsigned char* tag;
 341   tag = (unsigned char*) (String_val(str));
 342   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
 343   CAMLreturn (id);
 344 }
 345
 346 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
 347   return (NULLT);
 348 }
 349
 350 extern "C" CAMLprim value caml_unordered_set_length(value hset){
 351   CAMLparam1(hset);
 352   CAMLreturn (Val_int((HSET(hset))->size()));
 353 }
 354
 355 extern "C" CAMLprim value caml_unordered_set_alloc(value len){
 356   CAMLparam1(len);
 357   CAMLlocal1(hset);
 358   hset = caml_alloc_custom(&set_ops,sizeof(std::unordered_set<int>*),1,2);
 359   std::unordered_set<int>* ht = new std::unordered_set<int>();
 360   memcpy(Data_custom_val(hset),&ht,sizeof(std::unordered_set<int>*));
 361   CAMLreturn (hset);
 362 }
 363
 364 extern "C" CAMLprim value caml_unordered_set_set(value vec, value v){
 365   HSET(vec)->insert((int) Int_val(v));
 366   return (Val_unit);
 367 }
 368
 369 extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
 370   return (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
 371                                              HSET(tags))));
 372 }
 373 extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
 374   return (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
 375                                               HSET(tags))));
 376 }
 377 extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
 378   return (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
 379                                                     HSET(tags))));
 380 }
 381 extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
 382   return (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
 383                                                   HSET(tags),
 384                                                   TREENODEVAL(ctx))));
 385 }
 386
 387
 388 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
 389   CAMLparam2(tree,node);
 390   CAMLlocal1(tuple);
 391   tuple = caml_alloc_tuple(2);
 392   range r = (XMLTREE(tree)->DocIds(TREENODEVAL(node)));
 393   caml_initialize(&Field(tuple,0),Val_int(r.min));
 394   caml_initialize(&Field(tuple,1),Val_int(r.max));
 395   CAMLreturn (tuple);
 396 }
 397
 398 extern "C" value caml_result_set_create(value size){
 399   results* res = (results*) malloc(sizeof(results));
 400   results r = createResults (Int_val(size));
 401   res->n = r.n;
 402   res->lgn = r.lgn;
 403   res->tree = r.tree;
 404   return ((value) (res));
 405 }
 406
 407 extern "C" CAMLprim value caml_result_set_set(value result,value p){
 408   CAMLparam1(p);
 409   results r;
 410   setResult (  *((results*) result), Int_val(p));
 411   CAMLreturn (Val_unit);
 412 }
 413
 414 extern "C" CAMLprim value caml_result_set_clear(value result,value p1,value p2){
 415   CAMLparam2(p1,p2);
 416   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
 417   CAMLreturn (Val_unit);
 418 }
 419
 420 extern "C" CAMLprim value caml_result_set_next(value result,value p){
 421   CAMLparam1(p);
 422   results r;
 423   r = *( (results *) result);
 424   CAMLreturn (Val_int(nextResult(r, Int_val(p))));
 425 }
 426
 427 extern "C" CAMLprim value caml_xml_tree_print(value tree,value node,value fd){
 428   CAMLparam3(tree,node,fd);
 429   XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node));
 430   CAMLreturn(Val_unit);
 431 }
 432