1 /**************************************
4 * An Ocaml Driver which calls the C++ methods and
5 * adds a C wrapper interface with OCaml code.
13 * functions never doing any allocation (non caml_alloc*, caml_copy_string,...)
14 * have NOALLOC in the comment and their external declaration can have "noalloc"
18 #include <unordered_set>
20 #include "XMLDocShredder.h"
25 /* OCaml memory managment */
26 #include <caml/mlvalues.h>
27 #include <caml/alloc.h>
28 #include <caml/memory.h>
29 #include <caml/callback.h>
30 #include <caml/fail.h>
31 #include <caml/custom.h>
32 #include <caml/bigarray.h>
33 //#include "results.h"
36 #define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) ))
37 #define NOT_IMPLEMENTED(s) (caml_failwith(s))
38 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
39 #define HSET(x) ((TagIdSet*)((* (TagIdSet**) Data_custom_val(x))))
40 #define TEXTCOLLECTION(x)
41 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
42 #define TAGVAL(i) ((TagType) (Int_val(i)))
43 #define XMLTREE_ROOT 0
47 static struct custom_operations ops;
48 static struct custom_operations set_ops;
49 static value * cpp_exception = NULL;
50 static bool ops_initialized = false;
53 #include <sys/resource.h>
58 extern "C" void caml_xml_tree_finalize(value tree){
63 extern "C" void caml_hset_finalize(value hblock){
68 extern "C" value caml_init_lib (value unit) {
73 if (!ops_initialized){
75 getrlimit(RLIMIT_STACK, &rlim);
77 if (rlim.rlim_max == RLIM_INFINITY && rlim.rlim_cur != RLIM_INFINITY) {
78 rlim.rlim_cur = RLIM_INFINITY;
79 setrlimit(RLIMIT_STACK, &rlim);
82 ops.identifier = (char*) "XMLTree";
83 ops.finalize = caml_xml_tree_finalize;
84 set_ops.identifier = (char*) "unordered_set";
85 set_ops.finalize = caml_hset_finalize;
87 cpp_exception = caml_named_value("CPlusPlusError");
88 if (cpp_exception == NULL){
89 string s = "FATAL: Unregistered exception ";
90 s += "CPlusPlusError";
91 caml_failwith(s.c_str());
94 ops_initialized = true;
101 extern "C" value caml_shredder_parse(XMLDocShredder *shredder){
105 shredder->processStartDocument("");
107 shredder->processEndDocument();
108 doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
109 tree = (XMLTree *) shredder->getXMLTree();
110 memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
115 extern "C" value caml_call_shredder_uri(value uri,value sf, value iet, value dtc, value idtype){
118 char *fn = String_val(uri);
119 XMLDocShredder * shredder;
120 TextCollectionBuilder::index_type_t id;
121 switch (Int_val(idtype)){
123 id = TextCollectionBuilder::index_type_default;
126 id = TextCollectionBuilder::index_type_swcsa;
129 id = TextCollectionBuilder::index_type_rlcsa;
136 shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc), id);
137 doc = caml_shredder_parse(shredder);
140 catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
141 catch (string msg){ CAMLRAISEMSG(msg.c_str()); }
142 catch (char const * msg){ CAMLRAISEMSG(msg); };
146 extern "C" value caml_call_shredder_string(value data,value sf, value iet, value dtc, value idtype){
149 XMLDocShredder * shredder;
150 unsigned int ln = caml_string_length(data);
151 unsigned char *fn = (unsigned char*) String_val(data);
152 TextCollectionBuilder::index_type_t id;
153 switch (Int_val(idtype)){
155 id = TextCollectionBuilder::index_type_default;
158 id = TextCollectionBuilder::index_type_swcsa;
161 id = TextCollectionBuilder::index_type_rlcsa;
169 shredder = new XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc), id);
170 doc = caml_shredder_parse(shredder);
173 catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
174 catch (string msg){ CAMLRAISEMSG(msg.c_str()); }
175 catch (char const * msg){ CAMLRAISEMSG(msg); };
179 extern "C" value caml_xml_tree_save(value tree,value fd, value name){
180 CAMLparam3(tree, fd, name);
181 XMLTREE(tree)->Save(Int_val(fd), String_val(name));
182 CAMLreturn (Val_unit);
185 extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value sf){
186 CAMLparam4(fd, name, load_tc, sf);
190 tree = XMLTree::Load(Int_val(fd),Bool_val(load_tc),Int_val(sf), String_val(name));
191 doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
192 memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
195 catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); }
196 catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
197 catch (string msg){ CAMLRAISEMSG(msg.c_str()); }
198 catch (char const * msg){ CAMLRAISEMSG(msg); };
203 /*************************************************************************/
207 * All of the functions here call the _unsafe version and implement the logics themselves
208 * (test for NULLT and so on). This avoids one indirection + one call when the tests fails.
212 NoAlloc extern "C" value caml_xml_tree_root(value tree){
213 return (Val_int(XMLTREE_ROOT));
216 NoAlloc extern "C" value caml_xml_tree_size(value tree){
217 return (Val_int(XMLTREE(tree)->Size()));
220 NoAlloc extern "C" value caml_xml_tree_num_tags(value tree){
221 return (Val_int(XMLTREE(tree)->NumTags()));
224 NoAlloc extern "C" value caml_xml_tree_subtree_size(value tree, value node){
225 return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(node))));
228 NoAlloc extern "C" value caml_xml_tree_subtree_tags(value tree, value node, value tag){
229 return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(node), TAGVAL(tag))));
232 NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree, value node){
233 return (Val_int(XMLTREE(tree)->SubtreeElements(TREENODEVAL(node))));
236 NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
237 return (Val_bool(XMLTREE(tree)->IsLeaf(TREENODEVAL(node))));
240 NoAlloc extern "C" value caml_xml_tree_is_ancestor(value tree, value node1,value node2){
241 return (Val_bool(XMLTREE(tree)->IsAncestor(TREENODEVAL(node1),TREENODEVAL(node2))));
244 NoAlloc extern "C" value caml_xml_tree_is_child(value tree, value node1,value node2){
245 return (Val_bool(XMLTREE(tree)->IsChild(TREENODEVAL(node1),TREENODEVAL(node2))));
248 NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node){
249 return (Val_bool(XMLTREE(tree)->IsFirstChild(TREENODEVAL(node))));
251 NoAlloc extern "C" value caml_xml_tree_is_right_descendant(value tree, value x, value y){
252 return (Val_bool(XMLTREE(tree)->IsRightDescendant(TREENODEVAL(x), TREENODEVAL(y))));
254 NoAlloc extern "C" value caml_xml_tree_num_children(value tree, value node){
255 return (Val_int(XMLTREE(tree)->NumChildren(TREENODEVAL(node))));
258 NoAlloc extern "C" value caml_xml_tree_child_number(value tree, value node){
259 return (Val_int(XMLTREE(tree)->ChildNumber(TREENODEVAL(node))));
262 NoAlloc extern "C" value caml_xml_tree_depth(value tree, value node){
263 return (Val_int(XMLTREE(tree)->Depth(TREENODEVAL(node))));
266 NoAlloc extern "C" value caml_xml_tree_preorder(value tree, value node){
267 return (Val_int(XMLTREE(tree)->Preorder(TREENODEVAL(node))));
270 NoAlloc extern "C" value caml_xml_tree_postorder(value tree, value node){
271 return (Val_int(XMLTREE(tree)->Postorder(TREENODEVAL(node))));
274 NoAlloc extern "C" value caml_xml_tree_tag(value tree, value node) throw () {
275 return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(node))));
278 extern "C" value caml_xml_tree_doc_ids(value tree, value node){
279 CAMLparam2(tree,node);
282 tuple = caml_alloc(2,0);
283 ids = XMLTREE(tree)->DocIds(Int_val(node));
284 Store_field(tuple,0,Val_int(ids.min));
285 Store_field(tuple,1,Val_int(ids.max));
289 NoAlloc extern "C" value caml_xml_tree_parent(value tree, value node){
290 return (Val_int(XMLTREE(tree)->Parent(TREENODEVAL(node))));
293 NoAlloc extern "C" value caml_xml_tree_binary_parent(value tree, value node){
294 return (Val_int(XMLTREE(tree)->BinaryParent(TREENODEVAL(node))));
297 NoAlloc extern "C" value caml_xml_tree_child(value tree, value node,value idx){
298 return (Val_int(XMLTREE(tree)->Child(TREENODEVAL(node),Int_val(idx))));
301 NoAlloc extern "C" value caml_xml_tree_first_child(value tree, value node){
302 return (Val_int(XMLTREE(tree)->FirstChild(TREENODEVAL(node))));
305 NoAlloc extern "C" value caml_xml_tree_first_element(value tree, value node){
306 return (Val_int(XMLTREE(tree)->FirstElement(TREENODEVAL(node))));
309 NoAlloc extern "C" value caml_xml_tree_last_child(value tree, value node){
310 return (Val_int(XMLTREE(tree)->LastChild(TREENODEVAL(node))));
313 NoAlloc extern "C" value caml_xml_tree_next_sibling(value tree, value node){
314 return (Val_int(XMLTREE(tree)->NextSibling(TREENODEVAL(node))));
317 NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node){
318 return (Val_int(XMLTREE(tree)->NextElement(TREENODEVAL(node))));
321 NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node){
322 return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node))));
325 NoAlloc extern "C" value caml_xml_tree_tagged_child(value tree, value node,value tag){
326 return (Val_int(XMLTREE(tree)->TaggedChild(TREENODEVAL(node),TAGVAL(tag))));
329 NoAlloc extern "C" value caml_xml_tree_select_child(value tree, value node,value tags){
330 return (Val_int(XMLTREE(tree)->SelectChild(TREENODEVAL(node), HSET(tags))));
333 NoAlloc extern "C" value caml_xml_tree_tagged_following_sibling(value tree, value node,value tag){
334 return (Val_int(XMLTREE(tree)->TaggedFollowingSibling(TREENODEVAL(node),TAGVAL(tag))));
337 NoAlloc extern "C" value caml_xml_tree_select_following_sibling(value tree, value node,value tags){
338 return (Val_int(XMLTREE(tree)->SelectFollowingSibling(TREENODEVAL(node), HSET(tags))));
341 NoAlloc extern "C" value caml_xml_tree_tagged_descendant(value tree, value node, value tag){
342 return (Val_int(XMLTREE(tree)->TaggedDescendant(TREENODEVAL(node), TAGVAL(tag))));
345 NoAlloc extern "C" value caml_xml_tree_tagged_next(value tree, value node, value tag){
346 return (Val_int(XMLTREE(tree)->TaggedNext(TREENODEVAL(node), TAGVAL(tag))));
349 NoAlloc extern "C" value caml_xml_tree_select_descendant(value tree, value node, value tags){
350 return (Val_int(XMLTREE(tree)->SelectDescendant(TREENODEVAL(node), HSET(tags))));
353 NoAlloc extern "C" value caml_xml_tree_tagged_preceding(value tree, value node, value tag){
354 return (Val_int(XMLTREE(tree)->TaggedPreceding(TREENODEVAL(node), TAGVAL(tag))));
357 NoAlloc extern "C" value caml_xml_tree_tagged_following(value tree, value node, value tag){
358 return (Val_int(XMLTREE(tree)->TaggedFollowing(TREENODEVAL(node), TAGVAL(tag))));
361 NoAlloc extern "C" value caml_xml_tree_tagged_following_below(value tree, value node, value tag, value ancestor){
362 return (Val_int(XMLTREE(tree)->TaggedFollowingBelow(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(ancestor))));
365 NoAlloc extern "C" value caml_xml_tree_select_following_below(value tree, value node, value tags, value ancestor){
366 return (Val_int(XMLTREE(tree)->SelectFollowingBelow(TREENODEVAL(node), HSET(tags), TREENODEVAL(ancestor))));
369 NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree, value node, value tag, value closing){
370 return (Val_int(XMLTREE(tree)->TaggedFollowingBefore(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(closing))));
373 NoAlloc extern "C" value caml_xml_tree_select_following_before(value tree, value node, value tags, value closing){
374 return (Val_int(XMLTREE(tree)->SelectFollowingBefore(TREENODEVAL(node), HSET(tags), TREENODEVAL(closing))));
377 NoAlloc extern "C" value caml_xml_tree_tagged_ancestor(value tree, value node, value tag){
378 return (Val_int(XMLTREE(tree)->TaggedAncestor(TREENODEVAL(node), TAGVAL(tag))));
381 NoAlloc extern "C" value caml_xml_tree_my_text(value tree, value node){
382 return (Val_int(XMLTREE(tree)->MyText(TREENODEVAL(node))));
385 NoAlloc extern "C" value caml_xml_tree_my_text_unsafe(value tree, value node){
386 return (Val_int(XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(node))));
389 NoAlloc extern "C" value caml_xml_tree_text_xml_id(value tree, value docid){
390 return (Val_int(XMLTREE(tree)->TextXMLId(Int_val(docid))));
393 NoAlloc extern "C" value caml_xml_tree_node_xml_id(value tree, value node){
394 return (Val_int(XMLTREE(tree)->NodeXMLId(TREENODEVAL(node))));
397 NoAlloc extern "C" value caml_xml_tree_parent_node(value tree, value docid){
398 return (Val_int(XMLTREE(tree)->ParentNode(Int_val(docid))));
401 NoAlloc extern "C" value caml_xml_tree_prev_node(value tree, value docid){
402 return (Val_int(XMLTREE(tree)->PrevNode(Int_val(docid))));
405 extern "C" value caml_xml_tree_get_tag_id(value tree, value tagname){
406 CAMLparam2(tree,tagname);
408 unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
409 res = Val_int(XMLTREE(tree)->GetTagId(ctagname));
414 extern "C" value caml_xml_tree_get_tag_name(value tree, value tag){
415 CAMLparam2(tree,tag);
417 res = caml_copy_string((const char*) XMLTREE(tree)->GetTagNameByRef(TAGVAL(tag)));
421 extern "C" value caml_xml_tree_register_tag(value tree, value tagname){
422 CAMLparam2(tree,tagname);
424 unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
425 res = Val_int(XMLTREE(tree)->RegisterTag(ctagname));
431 NoAlloc extern "C" value caml_xml_tree_get_text_collection(value tree){
432 return((value) XMLTREE(tree)->getTextCollection());
435 NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node){
436 return (Val_int(XMLTREE(tree)->Closing(TREENODEVAL(node))));
439 NoAlloc extern "C" value caml_xml_tree_is_open(value tree, value node){
440 return (Val_bool(XMLTREE(tree)->IsOpen(TREENODEVAL(node))));
445 NoAlloc extern "C" value caml_xml_tree_nullt(value unit){
450 NoAlloc extern "C" value caml_unordered_set_length(value hset){
451 return (Val_int((HSET(hset))->size()));
454 extern "C" value caml_unordered_set_alloc(value unit){
457 hset = caml_alloc_custom(&set_ops,sizeof(TagIdSet*),1,2);
458 TagIdSet* ht = new TagIdSet();
459 memcpy(Data_custom_val(hset),&ht,sizeof(TagIdSet*));
463 NoAlloc extern "C" value caml_unordered_set_set(value set, value v){
464 HSET(set)->insert((int) Int_val(v));
468 // NoAlloc extern "C" value caml_result_set_create(value size){
469 // results* res = (results*) malloc(sizeof(results));
470 // results r = createResults (Int_val(size));
473 // res->tree = r.tree;
474 // return ((value) (res));
477 // NoAlloc extern "C" value caml_result_set_set(value result,value p){
478 // setResult ( *((results*) result), Int_val(p));
479 // return (Val_unit);
482 // NoAlloc extern "C" value caml_result_set_clear(value result,value p1,value p2){
483 // clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
484 // return (Val_unit);
487 // NoAlloc extern "C" value caml_result_set_next(value result,value p){
489 // r = *( (results *) result);
490 // return (Val_int(nextResult(r, Int_val(p))));
493 // NoAlloc extern "C" value caml_result_set_count(value result){
495 // r = *( (results *) result);
496 // return (Val_int(countResult(r)));
499 NoAlloc extern "C" value caml_xml_tree_print(value tree,value node,value fd){
500 CAMLparam3(tree,node,fd);
501 XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node), false);
502 CAMLreturn(Val_unit);
505 NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd){
507 XMLTREE(tree)->Flush(Int_val(fd));
508 CAMLreturn(Val_unit);
511 // NoAlloc extern "C" value caml_set_tag_bits(value result, value tag, value tree, value node)
514 // XMLTree *t = XMLTREE(Field(tree,0));
515 // treeNode opening = TREENODEVAL(node);
516 // treeNode closing = t->Closing(opening);
517 // TagType target_tag = Int_val(tag);
518 // treeNode first = t->TaggedDescendant(opening,target_tag);
519 // r = *( (results *) result);
521 // while (opening != NULLT){
522 // setResult(r,opening);
523 // opening = t->TaggedFollowingBefore(opening,target_tag,closing);
525 // return(Val_int(first));
529 NoAlloc extern "C" value caml_bit_vector_create(value size){
530 return (value) (new vector<bool>(Int_val(size),false));
533 NoAlloc extern "C" value caml_bit_vector_free(value vect){
534 delete ((vector<bool>*) vect);
538 NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){
539 return Val_bool (((vector<bool>*)vect)->at(Int_val(idx)));
542 NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){
543 (((vector<bool>*)vect)->at(Int_val(idx))) = (bool) Bool_val(b);
547 NoAlloc extern "C" value caml_bit_vector_next(value vect,value idx){
548 vector<bool>* bv = (vector<bool>*) vect;
549 int i = Int_val(idx);
551 while (i < l && !((*bv)[i]))
555 NoAlloc extern "C" value caml_bit_vector_prev(value vect,value idx){
556 int i = Int_val(idx);
557 while (i >= 0 && !((*((vector<bool>*) vect))[i]))
562 extern "C" value caml_bit_vector_node_array(value vect){
565 vector<bool>* bv = (vector<bool>*) vect;
570 if ((*bv)[i]) vr.push_back(i);
574 res = caml_alloc_tuple(l);
576 caml_initialize(&Field(res,i),Val_int(vr[i]));
581 int iterjump(XMLTree* tree, treeNode node, TagType tag, treeNode anc){
587 + iterjump(tree,tree->TaggedDescendant(node,tag),tag,node)
588 + iterjump(tree,tree->TaggedFollowingBelow(node,tag,anc),tag,anc);
592 extern "C" value caml_benchmark_jump(value tree,value tag){
594 treeNode root = XMLTREE(tree)->FirstChild(0);
595 root = XMLTREE(tree)->FirstChild(root);
596 count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
597 return Val_int(count);
600 int iterfcns(XMLTree* tree, treeNode node){
605 tmp += iterfcns(tree,tree->FirstChild(node));
606 tmp += iterfcns(tree,tree->NextSibling(node));
612 int iterfene(XMLTree* tree, treeNode node){
617 tmp += iterfene(tree,tree->FirstElement(node));
618 tmp += iterfene(tree,tree->NextElement(node));
624 extern "C" value caml_benchmark_fcns(value tree){
625 int i = iterfcns(XMLTREE(tree),0);
629 extern "C" value caml_benchmark_fene(value tree){
630 int i = iterfene(XMLTREE(tree),0);
634 int iterlcps(XMLTree* tree, treeNode node){
638 int x = tree->Tag(node);
639 x += iterlcps(tree,tree->LastChild(node));
640 x += iterlcps(tree,tree->PrevSibling(node));
645 int fulliterative(XMLTree* tree){
646 treeNode current = tree->Root();
647 treeNode next = NULLT;
648 int count = 1; //the root
652 while ((next = tree->FirstChild(current)) != NULLT) {
657 while ( (next = tree->NextSibling(current)) == NULLT){
658 current = tree->Parent(current);
659 if (current == NULLT) return count;
667 extern "C" value caml_benchmark_iter(value tree){
668 return Val_int(fulliterative(XMLTREE(tree)));
671 extern "C" value caml_benchmark_lcps(value tree){
673 iterlcps(XMLTREE(tree),0);
680 typedef struct dummy_node_ {
681 struct dummy_node_* first;
682 struct dummy_node_* next;
686 dummy_node * new_dummy_node () {
688 dummy_node * node = (dummy_node*) malloc(sizeof(dummy_node));
690 printf("%s","Cannot allocate memory\n");
695 void free_tree(dummy_node * node){
697 free_tree(node->first);
698 free_tree(node->next);
704 dummy_node * create_tree(XMLTree* tree, treeNode i, int mode){
708 dummy_node * f, *n, *r;
711 if (mode == 0) r = new_dummy_node();
712 f = create_tree(tree,tree->FirstChild(i), mode);
713 if (mode == 1) r = new_dummy_node();
714 n = create_tree(tree,tree->NextSibling(i), mode);
715 if (mode == 2) r = new_dummy_node();
722 int iter_tree(dummy_node * n){
726 return 1 + iter_tree (n->first) + iter_tree (n->next);
729 extern "C" value caml_build_pointers(value tree, value mode){
730 return ((value) create_tree(XMLTREE(Field(tree,0)),0, Int_val(mode)));
733 extern "C" value caml_iter_pointers (value node){
734 return Val_int(iter_tree((dummy_node*) node));
738 extern "C" value caml_free_pointers(value node){
739 free_tree((dummy_node*) node);
743 * Interface to the TextCollection
750 extern "C" value caml_text_collection_get_text(value tree, value id){
753 uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
754 str = caml_copy_string((const char*)txt);
759 extern "C" value caml_text_collection_empty_text(value tree,value id){
761 CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
764 bool docId_comp(DocID x, DocID y) { return x < y; };
767 * Existential queries
770 extern "C" value caml_text_collection_is_prefix(value tree,value str){
771 CAMLparam2(tree,str);
772 uchar * cstr = (uchar *) String_val(str);
773 CAMLreturn (Val_bool((int) XMLTREE(tree)->IsPrefix(cstr)));
776 extern "C" value caml_text_collection_is_suffix(value tree,value str){
777 CAMLparam2(tree,str);
778 uchar * cstr = (uchar *) String_val(str);
779 CAMLreturn (Val_bool((int) XMLTREE(tree)->IsSuffix(cstr)));
781 extern "C" value caml_text_collection_is_equal(value tree,value str){
782 CAMLparam2(tree,str);
783 uchar * cstr = (uchar *) String_val(str);
784 CAMLreturn (Val_bool((int) XMLTREE(tree)->IsEqual(cstr)));
786 extern "C" value caml_text_collection_is_contains(value tree,value str){
787 CAMLparam2(tree,str);
788 uchar * cstr = (uchar *) String_val(str);
789 CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
792 extern "C" value caml_text_collection_is_lessthan(value tree,value str){
793 CAMLparam2(tree,str);
794 uchar * cstr = (uchar *) String_val(str);
795 CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsLessThan(cstr)));
806 extern "C" value caml_text_collection_count(value tree,value str){
807 CAMLparam2(tree,str);
808 uchar * cstr = (uchar *) String_val(str);
809 CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
812 extern "C" value caml_text_collection_count_prefix(value tree,value str){
813 CAMLparam2(tree,str);
814 uchar * cstr = (uchar *) String_val(str);
815 CAMLreturn (Val_int((XMLTREE(tree)->CountPrefix(cstr))));
818 extern "C" value caml_text_collection_count_suffix(value tree,value str){
819 CAMLparam2(tree,str);
820 uchar * cstr = (uchar *) String_val(str);
821 CAMLreturn (Val_int((XMLTREE(tree)->CountSuffix(cstr))));
824 extern "C" value caml_text_collection_count_equal(value tree,value str){
825 CAMLparam2(tree,str);
826 uchar * cstr = (uchar *) String_val(str);
827 CAMLreturn (Val_int((XMLTREE(tree)->CountEqual(cstr))));
830 extern "C" value caml_text_collection_count_contains(value tree,value str){
831 CAMLparam2(tree,str);
832 uchar * cstr = (uchar *) String_val(str);
833 CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
836 extern "C" value caml_text_collection_count_lessthan(value tree,value str){
837 CAMLparam2(tree,str);
838 uchar * cstr = (uchar *) String_val(str);
839 CAMLreturn (Val_int((XMLTREE(tree)->CountLessThan(cstr))));
842 static value sort_alloc_array(std::vector<DocID> results, value resarray){
843 std::sort(results.begin(), results.end(), docId_comp);
844 size_t s = results.size();
845 resarray = caml_alloc_tuple(s);
846 for (size_t i = 0; i < s ;i++){
847 caml_initialize(&Field(resarray,i),Val_int(results[i]));
854 * Full reporting queries
857 extern "C" value caml_text_collection_prefix(value tree,value str){
858 CAMLparam2(tree,str);
859 CAMLlocal1(resarray);
860 uchar * cstr = (uchar *) String_val(str);
861 std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
862 CAMLreturn (sort_alloc_array(results,resarray));
865 extern "C" value caml_text_collection_suffix(value tree,value str){
866 CAMLparam2(tree,str);
867 CAMLlocal1(resarray);
868 uchar * cstr = (uchar *) String_val(str);
869 std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
870 CAMLreturn (sort_alloc_array(results,resarray));
873 extern "C" value caml_text_collection_equals(value tree,value str){
874 CAMLparam2(tree,str);
875 CAMLlocal1(resarray);
876 uchar * cstr = (uchar *) strdup(String_val(str));
877 std::vector<DocID> results = XMLTREE(tree)->Equals(cstr);
879 CAMLreturn (sort_alloc_array(results,resarray));
882 extern "C" value caml_text_collection_contains(value tree,value str){
883 CAMLparam2(tree,str);
884 CAMLlocal1(resarray);
885 uchar * cstr = (uchar *) String_val(str);
886 std::vector<DocID> results = XMLTREE(tree)->Contains(cstr);
887 CAMLreturn (sort_alloc_array(results,resarray));
890 extern "C" value caml_text_collection_lessthan(value tree,value str){
891 CAMLparam2(tree,str);
892 CAMLlocal1(resarray);
893 uchar * cstr = (uchar *) String_val(str);
894 std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
895 CAMLreturn (sort_alloc_array(results,resarray));
898 /** Full reporting into a bit vector
901 #define BV_QUERY(pref, Pref) \
902 extern "C" value caml_text_collection_## pref ##_bv(value tree, value str){ \
903 CAMLparam2(tree, str); \
904 CAMLlocal3(res, res_bv, res_array); \
906 uchar * cstr = (uchar *) strdup(String_val(str)); \
907 std::vector<DocID> results = XMLTREE(tree)->Pref(cstr); \
908 res_bv = caml_alloc_string((XMLTREE(tree)->Size() / 4) + 2); \
909 unsigned long slen = caml_string_length(res_bv); \
910 memset(&(Byte(res_bv,0)), 0, slen); \
911 res_array = caml_alloc_shr(results.size(), 0); \
912 for (unsigned int i = 0; i < results.size(); ++i) { \
913 j = XMLTREE(tree)->ParentNode(results[i]); \
914 Byte(res_bv, j >> 3) |= (1 << (j & 7)); \
915 caml_initialize(&Field(res_array, i), Val_int(j)); \
918 res = caml_alloc(2, 0); \
919 Store_field(res, 0, res_bv); \
920 Store_field(res, 1, res_array); \
925 BV_QUERY(prefix, Prefix)
926 BV_QUERY(suffix, Suffix)
927 BV_QUERY(equals, Equals)
928 BV_QUERY(contains, Contains)
929 BV_QUERY(lessthan, LessThan)