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   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_first_element(value tree, value id){
 252   return(Val_int (XMLTREE(tree)->FirstElement(TREENODEVAL(id))));
 253 }
 254
 255 extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
 256   return(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
 257 }
 258
 259 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
 260   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 261 }
 262
 263 extern "C" CAMLprim value caml_xml_tree_next_element(value tree, value id){
 264   return(Val_int (XMLTREE(tree)->NextElement(TREENODEVAL(id))));
 265 }
 266
 267 extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
 268   return(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
 269 }
 270
 271
 272 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
 273   return(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
 274 }
 275
 276 extern "C" CAMLprim value caml_xml_tree_tagged_desc(value tree, value id, value tag){
 277   return(Val_int (XMLTREE(tree)->TaggedDesc(TREENODEVAL(id),(TagType) Int_val(tag))));
 278 }
 279
 280
 281 extern "C" CAMLprim value caml_xml_tree_tagged_foll(value tree, value id, value tag){
 282   return(Val_int (XMLTREE(tree)->TaggedFoll(TREENODEVAL(id),(TagType) Int_val(tag))));
 283 }
 284 extern "C" CAMLprim value caml_xml_tree_tagged_foll_below(value tree, value id, value tag,value root){
 285   return(Val_int (XMLTREE(tree)->TaggedFollBelow(TREENODEVAL(id),(TagType) Int_val(tag),TREENODEVAL(root))));
 286 }
 287
 288
 289
 290 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
 291   return(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
 292 }
 293
 294 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
 295   return(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
 296 }
 297 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
 298   return(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
 299 }
 300
 301 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
 302   CAMLparam2(tree,tagid);
 303   CAMLlocal1(str);
 304   char* tag;
 305   tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
 306   str = caml_copy_string((const char*) tag);
 307   CAMLreturn (str);
 308 }
 309
 310
 311 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
 312   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
 313 }
 314
 315 extern "C" CAMLprim value caml_xml_tree_subtree_tags(value tree,value id,value tag){
 316   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(id),Int_val(tag))));
 317 }
 318
 319 extern "C" CAMLprim value caml_xml_tree_subtree_size(value tree,value id){
 320   return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(id))));
 321 }
 322
 323
 324 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
 325   CAMLparam2(tree,str);
 326   CAMLlocal1(id);
 327   unsigned char* tag;
 328   tag = (unsigned char*) (String_val(str));
 329   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
 330   CAMLreturn (id);
 331 }
 332
 333 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
 334   return (NULLT);
 335 }
 336
 337 extern "C" CAMLprim value caml_unordered_set_length(value hset){
 338   CAMLparam1(hset);
 339   CAMLreturn (Val_int((HSET(hset))->size()));
 340 }
 341
 342 extern "C" CAMLprim value caml_unordered_set_alloc(value len){
 343   CAMLparam1(len);
 344   CAMLlocal1(hset);
 345   hset = caml_alloc_custom(&set_ops,sizeof(std::unordered_set<int>*),1,2);
 346   std::unordered_set<int>* ht = new std::unordered_set<int>();
 347   memcpy(Data_custom_val(hset),&ht,sizeof(std::unordered_set<int>*));
 348   CAMLreturn (hset);
 349 }
 350
 351 extern "C" CAMLprim value caml_unordered_set_set(value vec, value v){
 352   HSET(vec)->insert((int) Int_val(v));
 353   return (Val_unit);
 354 }
 355
 356 extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
 357   return (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
 358                                              HSET(tags))));
 359 }
 360 extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
 361   return (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
 362                                               HSET(tags))));
 363 }
 364 extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
 365   return (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
 366                                                     HSET(tags))));
 367 }
 368 extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
 369   return (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
 370                                                   HSET(tags),
 371                                                   TREENODEVAL(ctx))));
 372 }
 373
 374
 375 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
 376   CAMLparam2(tree,node);
 377   CAMLlocal1(tuple);
 378   tuple = caml_alloc_tuple(2);
 379   range r = (XMLTREE(tree)->DocIds(TREENODEVAL(node)));
 380   caml_initialize(&Field(tuple,0),Val_int(r.min));
 381   caml_initialize(&Field(tuple,1),Val_int(r.max));
 382   CAMLreturn (tuple);
 383 }
 384
 385 extern "C" CAMLprim value caml_result_set_create(value size){
 386   CAMLparam1(size);
 387   results* res = (results*) malloc(sizeof(results));
 388   results r = createResults (Int_val(size));
 389   res->n = r.n;
 390   res->lgn = r.lgn;
 391   res->tree = r.tree;
 392   CAMLreturn ((value) (res));
 393 }
 394
 395 extern "C" CAMLprim value caml_result_set_set(value result,value p){
 396   CAMLparam2(result,p);
 397   setResult (  *((results*) result), Int_val(p));
 398   CAMLreturn (Val_unit);
 399 }
 400
 401 extern "C" CAMLprim value caml_result_set_clear(value result,value p1,value p2){
 402   CAMLparam3(result,p1,p2);
 403   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
 404   CAMLreturn (Val_unit);
 405 }
 406
 407 extern "C" CAMLprim value caml_result_set_next(value result,value p){
 408   CAMLparam2(result,p);
 409   CAMLreturn (Val_int(nextResult(*((results*) result), Int_val(p))));
 410 }
 411
 412