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