1 /**************************************
4 * An Ocaml Driver which calls the C++ methods and
5 * adds a C wrapper interface with OCaml code.
13 #include <unordered_set>
15 #include "XMLDocShredder.h"
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>
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
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;
44 extern "C" void caml_xml_tree_finalize(value tree){
49 extern "C" void caml_hset_finalize(value hblock){
54 extern "C" CAMLprim value caml_init_lib (value unit) {
56 if (!ops_initialized){
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;
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());
71 ops_initialized = true;
77 extern "C" CAMLprim value caml_shredder_parse(XMLDocShredder *shredder){
81 shredder->processStartDocument("");
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*));
91 extern "C" CAMLprim value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
94 char *fn = String_val(uri);
95 XMLDocShredder * shredder;
97 shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
98 doc = caml_shredder_parse(shredder);
101 catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
102 catch (string msg){ CAMLRAISEMSG(msg.c_str()); }
103 catch (char const * msg){ CAMLRAISEMSG(msg); };
107 extern "C" CAMLprim value caml_call_shredder_string(value data,value sf, value iet, value dtc){
110 XMLDocShredder * shredder;
111 unsigned int ln = string_length(data);
112 unsigned char *fn = (unsigned char*) String_val(data);
114 shredder = new XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));
115 doc = caml_shredder_parse(shredder);
118 catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
119 catch (string msg){ CAMLRAISEMSG(msg.c_str()); }
120 catch (char const * msg){ CAMLRAISEMSG(msg); };
124 extern "C" CAMLprim value caml_xml_tree_save(value tree,value fd){
126 XMLTREE(tree)->Save(Int_val(fd));
127 CAMLreturn (Val_unit);
130 extern "C" CAMLprim value caml_xml_tree_load(value fd){
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*));
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); };
148 extern "C" CAMLprim value caml_text_collection_get_text(value tree, value id){
151 uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
152 str = caml_copy_string((const char*)txt);
157 extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
160 char* txt = (char*) XMLTREE(tree)->GetText((DocID) Int_val(id));
161 str = caml_copy_string(txt);
167 extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
169 CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
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)));
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))));
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);
191 bool docId_comp(DocID x, DocID y) { return x < y; };
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);
200 std::sort(results.begin(), results.end(), docId_comp);
201 size_t s = results.size();
202 resarray = caml_alloc_tuple(s);
204 for (size_t i = 0; i < s ;i++){
205 caml_initialize(&Field(resarray,i),Val_int(results[i]));
207 CAMLreturn (resarray);
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);
219 extern "C" CAMLprim value caml_xml_tree_root(value tree){
221 CAMLreturn (Val_int(TREENODEVAL(XMLTREE_ROOT)));
223 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
225 CAMLreturn((value) XMLTREE(tree)->getTextCollection());
227 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
228 return(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
230 extern "C" CAMLprim value caml_xml_tree_prev_sibling(value tree, value id){
231 return(Val_int (XMLTREE(tree)->PrevSibling(TREENODEVAL(id))));
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))));
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))));
243 extern "C" CAMLprim value caml_xml_tree_last_child(value tree, value id){
244 return(Val_int (XMLTREE(tree)->LastChild(TREENODEVAL(id))));
247 extern "C" CAMLprim value caml_xml_tree_is_first_child(value tree, value id){
248 return Val_bool (XMLTREE(tree)->IsFirstChild(TREENODEVAL(id)));
250 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
251 return(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
253 extern "C" CAMLprim value caml_xml_tree_first_element(value tree, value id){
254 return(Val_int (XMLTREE(tree)->FirstElement(TREENODEVAL(id))));
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))));
261 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
262 return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
265 extern "C" CAMLprim value caml_xml_tree_next_element(value tree, value id){
266 return(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
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))));
274 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
275 return(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
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))));
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))));
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))));
292 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
293 return(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
296 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
297 return(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
299 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
300 return(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
303 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
304 CAMLparam2(tree,tagid);
307 tag = (char*) XMLTREE(tree)->GetTagNameByRef((TagType) (Int_val(tagid)));
308 str = caml_copy_string((const char*) tag);
313 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
314 return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
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))));
321 extern "C" CAMLprim value caml_xml_tree_subtree_size(value tree,value id){
322 return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(id))));
326 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
327 CAMLparam2(tree,str);
330 tag = (unsigned char*) (String_val(str));
331 id = Val_int(XMLTREE(tree)->RegisterTag(tag));
335 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
339 extern "C" CAMLprim value caml_unordered_set_length(value hset){
341 CAMLreturn (Val_int((HSET(hset))->size()));
344 extern "C" CAMLprim value caml_unordered_set_alloc(value len){
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>*));
353 extern "C" CAMLprim value caml_unordered_set_set(value vec, value v){
354 HSET(vec)->insert((int) Int_val(v));
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),
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),
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),
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),
377 extern "C" CAMLprim value caml_xml_tree_doc_ids(value tree, value node){
378 CAMLparam2(tree,node);
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));
387 extern "C" CAMLprim value caml_result_set_create(value size){
389 results* res = (results*) malloc(sizeof(results));
390 results r = createResults (Int_val(size));
394 CAMLreturn ((value) (res));
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);
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);
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))));