X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FOCamlDriver.cpp;h=8eb3a22ce681aaef83cfa7d9839535adb93dbea3;hb=ff13d22656fdbdffb2d909192bd17ba135606224;hp=275758a3128965fc22295a876bfe7e9a4071c5dc;hpb=d7e793e387b3a59877765e15c54649a9d74d137e;p=SXSI%2Fxpathcomp.git diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index 275758a..8eb3a22 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -17,165 +17,136 @@ #include #include -#include "XMLDocShredder.h" + #include "XMLTree.h" +#include "XMLTreeBuilder.h" #include "Utils.h" +#include "common_stub.hpp" extern "C" { -/* OCaml memory managment */ -#include -#include -#include -#include -#include -#include -#include - //#include "results.h" #include +} + +#define CAMLRAISEMSG(msg) (sxsi_raise_msg((char*) (msg))) + +#define XMLTREE(x) (Obj_val(x)) + +#define HSET(x) (Obj_val(x)) + +#define XMLTREEBUILDER(x) (Obj_val(x)) + -#define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) )) -#define NOT_IMPLEMENTED(s) (caml_failwith(s)) -#define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x))) -#define HSET(x) ((TagIdSet*)((* (TagIdSet**) Data_custom_val(x)))) -#define TEXTCOLLECTION(x) #define TREENODEVAL(i) ((treeNode) (Int_val(i))) #define TAGVAL(i) ((TagType) (Int_val(i))) #define XMLTREE_ROOT 0 #define NoAlloc - - static struct custom_operations ops; - static struct custom_operations set_ops; - static value * cpp_exception = NULL; - static bool ops_initialized = false; - +extern "C" { #include #include - - -} - -extern "C" void caml_xml_tree_finalize(value tree){ - delete XMLTREE(tree); - return; -} - -extern "C" void caml_hset_finalize(value hblock){ - delete HSET(hblock); - return; } -extern "C" value caml_init_lib (value unit) { - CAMLparam1(unit); - - struct rlimit rlim; - - if (!ops_initialized){ - getrlimit(RLIMIT_STACK, &rlim); - - if (rlim.rlim_max == RLIM_INFINITY && rlim.rlim_cur != RLIM_INFINITY) { - rlim.rlim_cur = RLIM_INFINITY; - setrlimit(RLIMIT_STACK, &rlim); - }; - ops.identifier = (char*) "XMLTree"; - ops.finalize = caml_xml_tree_finalize; - set_ops.identifier = (char*) "unordered_set"; - set_ops.finalize = caml_hset_finalize; - - cpp_exception = caml_named_value("CPlusPlusError"); - if (cpp_exception == NULL){ - string s = "FATAL: Unregistered exception "; - s += "CPlusPlusError"; - caml_failwith(s.c_str()); - }; - - ops_initialized = true; - - }; - CAMLreturn(Val_unit); - -} +/** XMLTreeBuilder bindings + * + */ -extern "C" value caml_shredder_parse(XMLDocShredder *shredder){ - CAMLparam0(); - CAMLlocal1(doc); - XMLTree * tree; - shredder->processStartDocument(""); - shredder->parse(); - shredder->processEndDocument(); - doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2); - tree = (XMLTree *) shredder->getXMLTree(); - memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*)); - CAMLreturn(doc); - -} - -extern "C" value caml_call_shredder_uri(value uri,value sf, value iet, value dtc, value idtype){ - CAMLparam1(uri); - CAMLlocal1(doc); - char *fn = String_val(uri); - XMLDocShredder * shredder; - TextCollectionBuilder::index_type_t id; - switch (Int_val(idtype)){ +extern "C" value caml_xml_tree_builder_create(value unit) +{ + CAMLparam1(unit); + CAMLlocal1(result); + result = sxsi_alloc_custom(); + Obj_val(result) = new XMLTreeBuilder(); + CAMLreturn(result); +} + +extern "C" value caml_xml_tree_builder_open_document(value vbuilder, + value vet, + value vsrate, + value vdtc, + value vidxtype) +{ + CAMLparam5(vbuilder, vet, vsrate, vdtc, vidxtype); + bool empty_text = Bool_val(vet); + int sample_rate = Int_val(vsrate); + bool disable_tc = Bool_val(vdtc); + TextCollectionBuilder::index_type_t idx_type; + switch (Int_val(vidxtype)){ case 0: - id = TextCollectionBuilder::index_type_default; + idx_type = TextCollectionBuilder::index_type_default; break; case 1: - id = TextCollectionBuilder::index_type_swcsa; + idx_type = TextCollectionBuilder::index_type_swcsa; break; case 2: - id = TextCollectionBuilder::index_type_rlcsa; + idx_type = TextCollectionBuilder::index_type_rlcsa; break; default: - CAMLRAISEMSG(""); + CAMLRAISEMSG("Invalid Index Type"); }; + int res = XMLTREEBUILDER(vbuilder)->OpenDocument(empty_text, + sample_rate, + disable_tc, + idx_type); + if (res == NULLT) + CAMLRAISEMSG("OpenDocument"); - try { - shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc), id); - doc = caml_shredder_parse(shredder); - delete shredder; - } - catch (const std::exception& e){ CAMLRAISEMSG(e.what()); } - catch (string msg){ CAMLRAISEMSG(msg.c_str()); } - catch (char const * msg){ CAMLRAISEMSG(msg); }; - CAMLreturn (doc); + CAMLreturn (Val_unit); +} +extern "C" value caml_xml_tree_builder_close_document(value vbuilder) +{ + CAMLparam1(vbuilder); + CAMLlocal1(result); + XMLTree * tree = XMLTREEBUILDER(vbuilder)->CloseDocument(); + if (tree == NULL) + CAMLRAISEMSG("CloseDocument"); + result = sxsi_alloc_custom(); + Obj_val(result) = tree; + CAMLreturn (result); } -extern "C" value caml_call_shredder_string(value data,value sf, value iet, value dtc, value idtype){ - CAMLparam1(data); - CAMLlocal1(doc); - XMLDocShredder * shredder; - unsigned int ln = caml_string_length(data); - unsigned char *fn = (unsigned char*) String_val(data); - TextCollectionBuilder::index_type_t id; - switch (Int_val(idtype)){ - case 0: - id = TextCollectionBuilder::index_type_default; - break; - case 1: - id = TextCollectionBuilder::index_type_swcsa; - break; - case 2: - id = TextCollectionBuilder::index_type_rlcsa; - break; - default: - CAMLRAISEMSG(""); - }; - try { +extern "C" value caml_xml_tree_builder_new_open_tag(value vbuilder, value vtag) +{ + CAMLparam2(vbuilder, vtag); + const char * tag = String_val(vtag); + if (XMLTREEBUILDER(vbuilder)->NewOpenTag(std::string(tag)) == NULLT) + CAMLRAISEMSG("NewOpenTag"); - shredder = new XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc), id); - doc = caml_shredder_parse(shredder); - delete shredder; - } - catch (const std::exception& e){ CAMLRAISEMSG(e.what()); } - catch (string msg){ CAMLRAISEMSG(msg.c_str()); } - catch (char const * msg){ CAMLRAISEMSG(msg); }; - CAMLreturn(doc); + CAMLreturn (Val_unit); +} + +extern "C" value caml_xml_tree_builder_new_closing_tag(value vbuilder, value vtag) +{ + CAMLparam2(vbuilder, vtag); + const char * tag = String_val(vtag); + if (XMLTREEBUILDER(vbuilder)->NewClosingTag(std::string(tag)) == NULLT) + CAMLRAISEMSG("NewClosingTag"); + + CAMLreturn (Val_unit); } +extern "C" value caml_xml_tree_builder_new_text(value vbuilder, value vtext) +{ + CAMLparam2(vbuilder, vtext); + const char * text = String_val(vtext); + if (XMLTREEBUILDER(vbuilder)->NewText(std::string(text)) == NULLT) + CAMLRAISEMSG("NewText"); + + CAMLreturn (Val_unit); +} + + +/*************************************************************************/ + +/** + * XMLTree bindings + * All of the functions here call the _unsafe version and implement the logics themselves + * (test for NULLT and so on). This avoids one indirection + one call when the tests fails. + */ + + extern "C" value caml_xml_tree_save(value tree,value fd, value name){ CAMLparam3(tree, fd, name); XMLTREE(tree)->Save(Int_val(fd), String_val(name)); @@ -184,31 +155,22 @@ extern "C" value caml_xml_tree_save(value tree,value fd, value name){ extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value sf){ CAMLparam4(fd, name, load_tc, sf); - CAMLlocal1(doc); + CAMLlocal1(result); XMLTree * tree; try { tree = XMLTree::Load(Int_val(fd),Bool_val(load_tc),Int_val(sf), String_val(name)); - doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2); - memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*)); - CAMLreturn(doc); + result = sxsi_alloc_custom(); + Obj_val(result) = tree; + CAMLreturn(result); } - catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); } catch (const std::exception& e){ CAMLRAISEMSG(e.what()); } - catch (string msg){ CAMLRAISEMSG(msg.c_str()); } + catch (std::string msg){ CAMLRAISEMSG(msg.c_str()); } catch (char const * msg){ CAMLRAISEMSG(msg); }; + //never reached + return (Val_unit); } - -/*************************************************************************/ - -/** - * XMLTree bindings - * All of the functions here call the _unsafe version and implement the logics themselves - * (test for NULLT and so on). This avoids one indirection + one call when the tests fails. - */ - - NoAlloc extern "C" value caml_xml_tree_root(value tree){ return (Val_int(XMLTREE_ROOT)); } @@ -454,9 +416,8 @@ NoAlloc extern "C" value caml_unordered_set_length(value hset){ extern "C" value caml_unordered_set_alloc(value unit){ CAMLparam1(unit); CAMLlocal1(hset); - hset = caml_alloc_custom(&set_ops,sizeof(TagIdSet*),1,2); - TagIdSet* ht = new TagIdSet(); - memcpy(Data_custom_val(hset),&ht,sizeof(TagIdSet*)); + hset = sxsi_alloc_custom(); + Obj_val(hset) = new TagIdSet(); CAMLreturn (hset); } @@ -761,7 +722,7 @@ extern "C" value caml_text_collection_empty_text(value tree,value id){ CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id)))); } -bool docId_comp(DocID x, DocID y) { return x < y; }; +bool docId_comp(DocID x, DocID y) { return x < y; } /** * Existential queries