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>*)((* (XMLTree**) 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   delete (txt);
 154   CAMLreturn (str);
 155 }
 156
 157 extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
 158   CAMLparam2(tree,id);
 159   CAMLlocal1(str);
 160   char* txt = (char*) XMLTREE(tree)->GetCachedText((DocID) Int_val(id));
 161   str = caml_copy_string(txt);
 162   free(txt);
 163   CAMLreturn (str);
 164 }
 165
 166
 167 extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
 168   CAMLparam2(tree,id);
 169   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
 170 }
 171
 172 extern "C" CAMLprim value caml_text_collection_is_contains(value tree,value str){
 173   CAMLparam2(tree,str);
 174   uchar * cstr = (uchar *) String_val(str);
 175   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
 176 }
 177
 178 extern "C" CAMLprim value caml_text_collection_count_contains(value tree,value str){
 179   CAMLparam2(tree,str);
 180   uchar * cstr = (uchar *) String_val(str);
 181   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
 182
 183 }
 184 extern "C" CAMLprim value caml_text_collection_count(value tree,value str){
 185   CAMLparam2(tree,str);
 186   uchar * cstr = (uchar *) String_val(str);
 187   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
 188   CAMLreturn (Val_unit);
 189
 190 }
 191 bool docId_comp(DocID x, DocID y) { return x < y; };
 192
 193 extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
 194   CAMLparam2(tree,str);
 195   CAMLlocal1(resarray);
 196   uchar * cstr = (uchar *) String_val(str);
 197   std::vector<DocID> results;
 198   results = XMLTREE(tree)->Contains(cstr);
 199   //free(cstr);
 200   std::sort(results.begin(), results.end(), docId_comp);
 201   size_t s = results.size();
 202   resarray = caml_alloc_tuple(s);
 203
 204   for (size_t i = 0; i < s ;i++){
 205     caml_initialize(&Field(resarray,i),Val_int(results[i]));
 206   };
 207   CAMLreturn (resarray);
 208 }
 209
 210 extern "C" CAMLprim value caml_text_collection_unsorted_contains(value tree,value str){
 211   CAMLparam2(tree,str);
 212   uchar * cstr = (uchar *) String_val(str);
 213   std::vector<DocID> results;
 214   results = XMLTREE(tree)->Contains(cstr);
 215   CAMLreturn (Val_unit);
 216 }
 217
 218
 219 extern "C" CAMLprim value caml_xml_tree_root(value tree){
 220   CAMLparam1(tree);
 221   CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
 222 }
 223 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
 224   CAMLparam1(tree);
 225   CAMLreturn((value) XMLTREE(tree)->getTextCollection());
 226 }
 227 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
 228   return(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
 229 }
 230 extern "C" CAMLprim value caml_xml_tree_prev_sibling(value tree, value id){
 231   return(Val_int (XMLTREE(tree)->PrevSibling(TREENODEVAL(id))));
 232 }
 233
 234 extern "C" CAMLprim value caml_xml_tree_parent_doc(value tree, value id){
 235   return (Val_int (XMLTREE(tree)->ParentNode((DocID) Int_val(id))));
 236 }
 237
 238 extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) {
 239   CAMLparam3(tree,id1,id2);
 240   CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2))));
 241 }
 242
 243 extern "C" CAMLprim value caml_xml_tree_last_child(value tree, value id){
 244   return(Val_int (XMLTREE(tree)->LastChild(TREENODEVAL(id))));
 245 }
 246
 247 extern "C" CAMLprim value caml_xml_tree_is_first_child(value tree, value id){
 248   return Val_bool (XMLTREE(tree)->IsFirstChild(TREENODEVAL(id)));
 249 }
 250 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
 251   return(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
 252 }
 253 extern "C" CAMLprim value caml_xml_tree_first_element(value tree, value id){
 254   return(Val_int (XMLTREE(tree)->FirstElement(TREENODEVAL(id))));
 255 }
 256
 257 extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
 258   return(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
 259 }
 260
 261 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
 262   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 263 }
 264
 265 extern "C" CAMLprim value caml_xml_tree_next_element(value tree, value id){
 266   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 267 }
 268
 269 extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
 270   return(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
 271 }
 272
 273
 274 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
 275   return(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
 276 }
 277
 278 extern "C" CAMLprim value caml_xml_tree_tagged_desc(value tree, value id, value tag){
 279   return(Val_int (XMLTREE(tree)->TaggedDesc(TREENODEVAL(id),(TagType) Int_val(tag))));
 280 }
 281
 282
 283 extern "C" CAMLprim value caml_xml_tree_tagged_foll(value tree, value id, value tag){
 284   return(Val_int (XMLTREE(tree)->TaggedFoll(TREENODEVAL(id),(TagType) Int_val(tag))));
 285 }
 286 extern "C" CAMLprim value caml_xml_tree_tagged_foll_below(value tree, value id, value tag,value root){
 287   return(Val_int (XMLTREE(tree)->TaggedFollBelow(TREENODEVAL(id),(TagType) Int_val(tag),TREENODEVAL(root))));
 288 }
 289
 290
 291
 292 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
 293   return(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
 294 }
 295
 296 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
 297   return(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
 298 }
 299 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
 300   return(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
 301 }
 302
 303 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
 304   CAMLparam2(tree,tagid);
 305   CAMLlocal1(str);
 306   char* tag;
 307   tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
 308   str = caml_copy_string((const char*) tag);
 309   CAMLreturn (str);
 310 }
 311
 312
 313 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
 314   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
 315 }
 316
 317 extern "C" CAMLprim value caml_xml_tree_subtree_tags(value tree,value id,value tag){
 318   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(id),Int_val(tag))));
 319 }
 320
 321 extern "C" CAMLprim value caml_xml_tree_subtree_size(value tree,value id){
 322   return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(id))));
 323 }
 324
 325
 326 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
 327   CAMLparam2(tree,str);
 328   CAMLlocal1(id);
 329   unsigned char* tag;
 330   tag = (unsigned char*) (String_val(str));
 331   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
 332   CAMLreturn (id);
 333 }
 334
 335 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
 336   return (NULLT);
 337 }
 338
 339 extern "C" CAMLprim value caml_unordered_set_length(value hset){
 340   CAMLparam1(hset);
 341   CAMLreturn (Val_int((HSET(hset))->size()));
 342 }
 343
 344 extern "C" CAMLprim value caml_unordered_set_alloc(value len){
 345   CAMLparam1(len);
 346   CAMLlocal1(hset);
 347   hset = caml_alloc_custom(&set_ops,sizeof(std::unordered_set<int>*),1,2);
 348   std::unordered_set<int>* ht = new std::unordered_set<int>();
 349   memcpy(Data_custom_val(hset),&ht,sizeof(std::unordered_set<int>*));
 350   CAMLreturn (hset);
 351 }
 352
 353 extern "C" CAMLprim value caml_unordered_set_set(value vec, value v){
 354   HSET(vec)->insert((int) Int_val(v));
 355   return (Val_unit);
 356 }
 357
 358 extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
 359   return (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
 360                                              HSET(tags))));
 361 }
 362 extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
 363   return (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
 364                                               HSET(tags))));
 365 }
 366 extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
 367   return (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
 368                                                     HSET(tags))));
 369 }
 370 extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
 371   return (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
 372                                                   HSET(tags),
 373                                                   TREENODEVAL(ctx))));
 374 }
 375
 376
 377 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
 378   CAMLparam2(tree,node);
 379   CAMLlocal1(tuple);
 380   tuple = caml_alloc_tuple(2);
 381   range r = (XMLTREE(tree)->DocIds(TREENODEVAL(node)));
 382   caml_initialize(&Field(tuple,0),Val_int(r.min));
 383   caml_initialize(&Field(tuple,1),Val_int(r.max));
 384   CAMLreturn (tuple);
 385 }
 386
 387 extern "C" CAMLprim value caml_result_set_create(value size){
 388   CAMLparam1(size);
 389   results* res = (results*) malloc(sizeof(results));
 390   results r = createResults (Int_val(size));
 391   res->n = r.n;
 392   res->lgn = r.lgn;
 393   res->tree = r.tree;
 394   CAMLreturn ((value) (res));
 395 }
 396
 397 extern "C" CAMLprim value caml_result_set_set(value result,value p){
 398   CAMLparam2(result,p);
 399   setResult (  *((results*) result), Int_val(p));
 400   CAMLreturn (Val_unit);
 401 }
 402
 403 extern "C" CAMLprim value caml_result_set_clear(value result,value p1,value p2){
 404   CAMLparam3(result,p1,p2);
 405   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
 406   CAMLreturn (Val_unit);
 407 }
 408
 409 extern "C" CAMLprim value caml_result_set_next(value result,value p){
 410   CAMLparam2(result,p);
 411   CAMLreturn (Val_int(nextResult(*((results*) result), Int_val(p))));
 412 }
 413
 414