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 #include <unordered_set>
  13 extern "C" {
  14 #include <caml/mlvalues.h>
  15 #include <caml/alloc.h>
  16 #include <caml/memory.h>
  17 #include <caml/callback.h>
  18 #include <caml/fail.h>
  19 #include <caml/custom.h>
  20
  21
  22 } //extern C
  23
  24
  25 //#include "TextCollection/TextCollection.h"
  26 #include "XMLDocShredder.h"
  27 #include "XMLTree.h"
  28 #include "Utils.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>*)((* (XMLTree**) Data_custom_val(x))))
  34 #define TEXTCOLLECTION(x)
  35 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
  36 #define XMLTREE_ROOT 0
  37
  38
  39
  40 extern "C" {
  41   static struct custom_operations ops;
  42   static struct custom_operations set_ops;
  43   static value * cpp_exception = NULL;
  44   static bool ops_initialized = false;
  45
  46 }
  47 extern "C" void caml_xml_tree_finalize(value tree){
  48   delete XMLTREE(tree);
  49   return;
  50 }
  51 extern "C" void caml_hset_finalize(value hblock){
  52   delete HSET(hblock);
  53   return;
  54 }
  55
  56 extern "C" CAMLprim value caml_init_lib (value unit) {
  57   CAMLparam1(unit);
  58   if (!ops_initialized){
  59
  60
  61   ops.identifier = (char*) "XMLTree";
  62   ops.finalize = caml_xml_tree_finalize;
  63   set_ops.identifier = (char*) "unordered_set";
  64   set_ops.finalize = caml_hset_finalize;
  65
  66   cpp_exception = caml_named_value("CPlusPlusError");
  67
  68   ops_initialized = true;
  69
  70   };
  71   CAMLreturn(Val_unit);
  72
  73 }
  74 extern "C" CAMLprim value caml_shredder_parse(XMLDocShredder *shredder){
  75   CAMLparam0();
  76   CAMLlocal1(doc);
  77   XMLTree * tree;
  78   shredder->processStartDocument("");
  79   shredder->parse();
  80   shredder->processEndDocument();
  81   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
  82   tree = (XMLTree *) shredder->getXMLTree();
  83   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
  84   CAMLreturn(doc);
  85
  86 }
  87
  88 extern "C" CAMLprim value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
  89   CAMLparam1(uri);
  90   CAMLlocal1(doc);
  91   char *fn = String_val(uri);
  92   XMLDocShredder * shredder;
  93   try {
  94     shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
  95     doc = caml_shredder_parse(shredder);
  96     delete shredder;
  97   }
  98   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
  99   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 100   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 101   CAMLreturn (doc);
 102
 103 }
 104 extern "C" CAMLprim value caml_call_shredder_string(value data,value sf, value iet, value dtc){
 105   CAMLparam1(data);
 106   CAMLlocal1(doc);
 107   XMLDocShredder * shredder;
 108   unsigned int ln = string_length(data);
 109   unsigned char *fn = (unsigned char*) String_val(data);
 110   try {
 111     shredder = new  XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));
 112     doc = caml_shredder_parse(shredder);
 113     delete shredder;
 114   }
 115   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 116   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 117   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 118   CAMLreturn(doc);
 119 }
 120
 121 extern "C" CAMLprim value caml_xml_tree_save(value tree,value fd){
 122   CAMLparam2(tree,fd);
 123   XMLTREE(tree)->Save(Int_val(fd));
 124   CAMLreturn (Val_unit);
 125 }
 126
 127 extern "C" CAMLprim value caml_xml_tree_load(value fd){
 128   CAMLparam1(fd);
 129   CAMLlocal1(doc);
 130   XMLTree * tree;
 131   try {
 132   tree = XMLTree::Load(Int_val(fd));
 133   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
 134   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
 135   CAMLreturn(doc);
 136   }
 137   catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); }
 138   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
 139   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
 140   catch (char const * msg){ CAMLRAISEMSG(msg);  };
 141 }
 142
 143
 144
 145 extern "C" CAMLprim value caml_text_collection_get_text(value tree, value id){
 146   CAMLparam2(tree,id);
 147   CAMLlocal1(str);
 148   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
 149   str = caml_copy_string((const char*)txt);
 150   delete (txt);
 151   CAMLreturn (str);
 152 }
 153
 154 extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
 155   CAMLparam2(tree,id);
 156   CAMLlocal1(str);
 157   char* txt = (char*) XMLTREE(tree)->GetCachedText((DocID) Int_val(id));
 158   str = caml_copy_string(txt);
 159   free(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
 189 extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
 190   CAMLparam2(tree,str);
 191   CAMLlocal1(resarray);
 192   uchar * cstr = (uchar *) String_val(str);
 193   std::vector<DocID> results;
 194   results = XMLTREE(tree)->Contains(cstr);
 195   //free(cstr);
 196   resarray = caml_alloc_tuple(results.size());
 197
 198   for (unsigned int i=0; i<results.size();i++){
 199     caml_initialize(&Field(resarray,i),Val_int(results[i]));
 200   };
 201   CAMLreturn (resarray);
 202 }
 203 extern "C" CAMLprim value caml_text_collection_unsorted_contains(value tree,value str){
 204   CAMLparam2(tree,str);
 205   uchar * cstr = (uchar *) String_val(str);
 206   std::vector<DocID> results;
 207   results = XMLTREE(tree)->Contains(cstr);
 208   CAMLreturn (Val_unit);
 209 }
 210
 211
 212 extern "C" CAMLprim value caml_xml_tree_root(value tree){
 213   CAMLparam1(tree);
 214   CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
 215 }
 216 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
 217   CAMLparam1(tree);
 218   CAMLreturn((value) XMLTREE(tree)->getTextCollection());
 219 }
 220 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
 221   return(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
 222 }
 223 extern "C" CAMLprim value caml_xml_tree_prev_sibling(value tree, value id){
 224   return(Val_int (XMLTREE(tree)->PrevSibling(TREENODEVAL(id))));
 225 }
 226
 227 extern "C" CAMLprim value caml_xml_tree_parent_doc(value tree, value id){
 228   return (Val_int (XMLTREE(tree)->ParentNode((DocID) Int_val(id))));
 229 }
 230
 231
 232 extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) {
 233   CAMLparam3(tree,id1,id2);
 234   CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2))));
 235 }
 236
 237 extern "C" CAMLprim value caml_xml_tree_last_child(value tree, value id){
 238   return(Val_int (XMLTREE(tree)->LastChild(TREENODEVAL(id))));
 239 }
 240
 241 extern "C" CAMLprim value caml_xml_tree_is_first_child(value tree, value id){
 242   return Val_bool (XMLTREE(tree)->IsFirstChild(TREENODEVAL(id)));
 243 }
 244 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
 245   return(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
 246 }
 247 extern "C" CAMLprim value caml_xml_tree_first_element(value tree, value id){
 248   return(Val_int (XMLTREE(tree)->FirstElement(TREENODEVAL(id))));
 249 }
 250
 251 extern "C" CAMLprim value caml_xml_tree_tagged_child(value tree, value id, value tag){
 252   return(Val_int (XMLTREE(tree)->TaggedChild(TREENODEVAL(id),Int_val(tag))));
 253 }
 254
 255 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
 256   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 257 }
 258
 259 extern "C" CAMLprim value caml_xml_tree_next_element(value tree, value id){
 260   return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
 261 }
 262
 263 extern "C" CAMLprim value caml_xml_tree_tagged_sibling(value tree, value id, value tag){
 264   return(Val_int (XMLTREE(tree)->TaggedFollSibling(TREENODEVAL(id),Int_val(tag))));
 265 }
 266
 267
 268 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
 269   return(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
 270 }
 271
 272 extern "C" CAMLprim value caml_xml_tree_tagged_desc(value tree, value id, value tag){
 273   return(Val_int (XMLTREE(tree)->TaggedDesc(TREENODEVAL(id),(TagType) Int_val(tag))));
 274 }
 275
 276
 277 extern "C" CAMLprim value caml_xml_tree_tagged_foll(value tree, value id, value tag){
 278   return(Val_int (XMLTREE(tree)->TaggedFoll(TREENODEVAL(id),(TagType) Int_val(tag))));
 279 }
 280 extern "C" CAMLprim value caml_xml_tree_tagged_foll_below(value tree, value id, value tag,value root){
 281   return(Val_int (XMLTREE(tree)->TaggedFollBelow(TREENODEVAL(id),(TagType) Int_val(tag),TREENODEVAL(root))));
 282 }
 283
 284
 285
 286 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
 287   return(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   return(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
 292 }
 293 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
 294   return(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
 295 }
 296
 297 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
 298   CAMLparam2(tree,tagid);
 299   CAMLlocal1(str);
 300   char* tag;
 301   tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
 302   str = caml_copy_string((const char*) tag);
 303   CAMLreturn (str);
 304 }
 305
 306
 307 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
 308   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
 309 }
 310
 311 extern "C" CAMLprim value caml_xml_tree_subtree_tags(value tree,value id,value tag){
 312   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(id),Int_val(tag))));
 313 }
 314
 315
 316 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
 317   CAMLparam2(tree,str);
 318   CAMLlocal1(id);
 319   unsigned char* tag;
 320   tag = (unsigned char*) (String_val(str));
 321   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
 322   CAMLreturn (id);
 323 }
 324
 325 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
 326   return (NULLT);
 327 }
 328
 329 extern "C" CAMLprim value caml_unordered_set_length(value hset){
 330   CAMLparam1(hset);
 331   CAMLreturn (Val_int((HSET(hset))->size()));
 332 }
 333
 334 extern "C" CAMLprim value caml_unordered_set_alloc(value len){
 335   CAMLparam1(len);
 336   CAMLlocal1(hset);
 337   hset = caml_alloc_custom(&set_ops,sizeof(std::unordered_set<int>*),1,2);
 338   std::unordered_set<int>* ht = new std::unordered_set<int>();
 339   memcpy(Data_custom_val(hset),&ht,sizeof(std::unordered_set<int>*));
 340   CAMLreturn (hset);
 341 }
 342
 343 extern "C" CAMLprim value caml_unordered_set_set(value vec, value v){
 344   HSET(vec)->insert((int) Int_val(v));
 345   return (Val_unit);
 346 }
 347
 348 extern "C" CAMLprim value caml_xml_tree_select_desc(value tree, value node, value tags){
 349   return (Val_int (XMLTREE(tree)->SelectDesc(TREENODEVAL(node),
 350                                              HSET(tags))));
 351 }
 352 extern "C" CAMLprim value caml_xml_tree_select_child(value tree, value node, value tags){
 353   return (Val_int (XMLTREE(tree)->SelectChild(TREENODEVAL(node),
 354                                               HSET(tags))));
 355 }
 356 extern "C" CAMLprim value caml_xml_tree_select_foll_sibling(value tree, value node, value tags){
 357   return (Val_int (XMLTREE(tree)->SelectFollSibling(TREENODEVAL(node),
 358                                                     HSET(tags))));
 359 }
 360 extern "C" CAMLprim value caml_xml_tree_select_foll_below(value tree, value node, value tags,value ctx){
 361   return (Val_int (XMLTREE(tree)->SelectFollBelow(TREENODEVAL(node),
 362                                                   HSET(tags),
 363                                                   TREENODEVAL(ctx))));
 364 }
 365
 366
 367 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
 368   CAMLparam2(tree,node);
 369   CAMLlocal1(tuple);
 370   tuple = caml_alloc_tuple(2);
 371   range r = (XMLTREE(tree)->DocIds(TREENODEVAL(node)));
 372   caml_initialize(&Field(tuple,0),Val_int(r.min));
 373   caml_initialize(&Field(tuple,1),Val_int(r.max));
 374   CAMLreturn (tuple);
 375 }