return Val_long( ( 1 << (sizeof(unsigned long)*8 - __builtin_clzl(Long_val(i)) - 1)));
}
-/** XMLTreeBuilder bindings
- *
- */
-
-extern "C" value caml_xml_tree_builder_create(value unit)
-{
- CAMLparam1(unit);
- CAMLlocal1(result);
- result = sxsi_alloc_custom<XMLTreeBuilder*>();
- Obj_val<XMLTreeBuilder*>(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:
- idx_type = TextCollectionBuilder::index_type_default;
- break;
- case 1:
- idx_type = TextCollectionBuilder::index_type_swcsa;
- break;
- case 2:
- idx_type = TextCollectionBuilder::index_type_rlcsa;
- break;
- default:
- CAMLRAISEMSG("Invalid Index Type");
- };
- int res = XMLTREEBUILDER(vbuilder)->OpenDocument(empty_text,
- sample_rate,
- disable_tc,
- idx_type);
- if (res == NULLT)
- CAMLRAISEMSG("OpenDocument");
-
- 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<XMLTree*>();
- Obj_val<XMLTree*>(result) = tree;
- CAMLreturn (result);
-}
-
-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");
-
- 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));
- CAMLreturn (Val_unit);
-}
-
-extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value sf){
- CAMLparam4(fd, name, load_tc, sf);
- CAMLlocal1(result);
- XMLTree * tree;
- try {
-
- tree = XMLTree::Load(Int_val(fd), Bool_val(load_tc), Int_val(sf), String_val(name));
- result = sxsi_alloc_custom<XMLTree*>();
- Obj_val<XMLTree*>(result) = tree;
- CAMLreturn(result);
- }
- catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
- catch (std::string msg){ CAMLRAISEMSG(msg.c_str()); }
- catch (char const * msg){ CAMLRAISEMSG(msg); };
- //never reached
- return (Val_unit);
-}
-
-
-NoAlloc extern "C" value caml_xml_tree_root(value tree){
- return (Val_int(XMLTREE_ROOT));
-}
-
-NoAlloc extern "C" value caml_xml_tree_size(value tree){
- return (Val_int(XMLTREE(tree)->Size()));
-}
-
-NoAlloc extern "C" value caml_xml_tree_num_tags(value tree){
- return (Val_int(XMLTREE(tree)->NumTags()));
-}
-
-NoAlloc extern "C" value caml_xml_tree_subtree_size(value tree, value node){
- return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_subtree_tags(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree, value node){
- return (Val_int(XMLTREE(tree)->SubtreeElements(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
- return (Val_bool(XMLTREE(tree)->IsLeaf(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_is_ancestor(value tree, value node1,value node2){
- return (Val_bool(XMLTREE(tree)->IsAncestor(TREENODEVAL(node1),TREENODEVAL(node2))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_is_child(value tree, value node1,value node2){
- return (Val_bool(XMLTREE(tree)->IsChild(TREENODEVAL(node1),TREENODEVAL(node2))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node){
- return (Val_bool(XMLTREE(tree)->IsFirstChild(TREENODEVAL(node))));
-}
-NoAlloc extern "C" value caml_xml_tree_is_right_descendant(value tree, value x, value y){
- return (Val_bool(XMLTREE(tree)->IsRightDescendant(TREENODEVAL(x), TREENODEVAL(y))));
-}
-NoAlloc extern "C" value caml_xml_tree_num_children(value tree, value node){
- return (Val_int(XMLTREE(tree)->NumChildren(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_child_number(value tree, value node){
- return (Val_int(XMLTREE(tree)->ChildNumber(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_depth(value tree, value node){
- return (Val_int(XMLTREE(tree)->Depth(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_preorder(value tree, value node){
- return (Val_int(XMLTREE(tree)->Preorder(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_postorder(value tree, value node){
- return (Val_int(XMLTREE(tree)->Postorder(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tag(value tree, value node) throw () {
- return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(node))));
-}
-
-extern "C" value caml_xml_tree_doc_ids(value tree, value node){
- CAMLparam2(tree,node);
- CAMLlocal1(tuple);
- range ids;
- tuple = caml_alloc(2,0);
- ids = XMLTREE(tree)->DocIds(Int_val(node));
- Store_field(tuple,0,Val_int(ids.min));
- Store_field(tuple,1,Val_int(ids.max));
- CAMLreturn (tuple);
-}
-
-NoAlloc extern "C" value caml_xml_tree_parent(value tree, value node){
- return (Val_int(XMLTREE(tree)->Parent(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_binary_parent(value tree, value node){
- return (Val_int(XMLTREE(tree)->BinaryParent(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_child(value tree, value node,value idx){
- return (Val_int(XMLTREE(tree)->Child(TREENODEVAL(node),Int_val(idx))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_first_child(value tree, value node){
- return (Val_int(XMLTREE(tree)->FirstChild(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_first_element(value tree, value node){
- return (Val_int(XMLTREE(tree)->FirstElement(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_last_child(value tree, value node){
- return (Val_int(XMLTREE(tree)->LastChild(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_next_sibling(value tree, value node){
- return (Val_int(XMLTREE(tree)->NextSibling(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node){
- return (Val_int(XMLTREE(tree)->NextElement(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_next_node_before(value tree, value node, value ctx){
- return (Val_int(XMLTREE(tree)->NextNodeBefore(TREENODEVAL(node), TREENODEVAL(ctx))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node){
- return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_child(value tree, value node,value tag){
- return (Val_int(XMLTREE(tree)->TaggedChild(TREENODEVAL(node),TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_select_child(value tree, value node,value tags){
- return (Val_int(XMLTREE(tree)->SelectChild(TREENODEVAL(node), HSET(tags))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_following_sibling(value tree, value node,value tag){
- return (Val_int(XMLTREE(tree)->TaggedFollowingSibling(TREENODEVAL(node),TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_select_following_sibling(value tree, value node,value tags){
- return (Val_int(XMLTREE(tree)->SelectFollowingSibling(TREENODEVAL(node), HSET(tags))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_descendant(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->TaggedDescendant(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_next(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->TaggedNext(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_select_descendant(value tree, value node, value tags){
- return (Val_int(XMLTREE(tree)->SelectDescendant(TREENODEVAL(node), HSET(tags))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_preceding(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->TaggedPreceding(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_following(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->TaggedFollowing(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_following_below(value tree, value node, value tag, value ancestor){
- return (Val_int(XMLTREE(tree)->TaggedFollowingBelow(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(ancestor))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_select_following_below(value tree, value node, value tags, value ancestor){
- return (Val_int(XMLTREE(tree)->SelectFollowingBelow(TREENODEVAL(node), HSET(tags), TREENODEVAL(ancestor))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree, value node, value tag, value closing){
- return (Val_int(XMLTREE(tree)->TaggedFollowingBefore(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(closing))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_select_following_before(value tree, value node, value tags, value closing){
- return (Val_int(XMLTREE(tree)->SelectFollowingBefore(TREENODEVAL(node), HSET(tags), TREENODEVAL(closing))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_tagged_ancestor(value tree, value node, value tag){
- return (Val_int(XMLTREE(tree)->TaggedAncestor(TREENODEVAL(node), TAGVAL(tag))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_my_text(value tree, value node){
- return (Val_int(XMLTREE(tree)->MyText(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_my_text_unsafe(value tree, value node){
- return (Val_int(XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_text_xml_id(value tree, value docid){
- return (Val_int(XMLTREE(tree)->TextXMLId(Int_val(docid))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_node_xml_id(value tree, value node){
- return (Val_int(XMLTREE(tree)->NodeXMLId(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_parent_node(value tree, value docid){
- return (Val_int(XMLTREE(tree)->ParentNode(Int_val(docid))));
-}
-/*
-NoAlloc extern "C" value caml_xml_tree_prev_node(value tree, value docid){
- return (Val_int(XMLTREE(tree)->PrevNode(Int_val(docid))));
-}
-*/
-extern "C" value caml_xml_tree_get_tag_id(value tree, value tagname){
- CAMLparam2(tree,tagname);
- CAMLlocal1(res);
- unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
- res = Val_int(XMLTREE(tree)->GetTagId(ctagname));
- free(ctagname);
- CAMLreturn(res);
-}
-
-extern "C" value caml_xml_tree_get_tag_name(value tree, value tag){
- CAMLparam2(tree,tag);
- CAMLlocal1(res);
- res = caml_copy_string((const char*) XMLTREE(tree)->GetTagNameByRef(TAGVAL(tag)));
- CAMLreturn(res);
-}
-
-extern "C" value caml_xml_tree_register_tag(value tree, value tagname){
- CAMLparam2(tree,tagname);
- CAMLlocal1(res);
- unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
- res = Val_int(XMLTREE(tree)->RegisterTag(ctagname));
- free(ctagname);
- CAMLreturn(res);
-}
-
-
-NoAlloc extern "C" value caml_xml_tree_get_text_collection(value tree){
- return((value) XMLTREE(tree)->getTextCollection());
-}
-
-NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node){
- return (Val_int(XMLTREE(tree)->Closing(TREENODEVAL(node))));
-}
-
-NoAlloc extern "C" value caml_xml_tree_is_open(value tree, value node){
- return (Val_bool(XMLTREE(tree)->IsOpen(TREENODEVAL(node))));
-}
-
-
-
-NoAlloc extern "C" value caml_xml_tree_nullt(value unit){
- return (NULLT);
-}
-
-
-NoAlloc extern "C" value caml_unordered_set_length(value hset){
- return (Val_int((HSET(hset))->size()));
-}
-
-extern "C" value caml_unordered_set_alloc(value unit){
- CAMLparam1(unit);
- CAMLlocal1(hset);
- hset = sxsi_alloc_custom<TagIdSet*>();
- Obj_val<TagIdSet*>(hset) = new TagIdSet();
- CAMLreturn (hset);
-}
-
-NoAlloc extern "C" value caml_unordered_set_set(value set, value v){
- HSET(set)->insert((int) Int_val(v));
- return (Val_unit);
-}
-
-// NoAlloc extern "C" value caml_result_set_create(value size){
-// results* res = (results*) malloc(sizeof(results));
-// results r = createResults (Int_val(size));
-// res->n = r.n;
-// res->lgn = r.lgn;
-// res->tree = r.tree;
-// return ((value) (res));
-// }
-
-// NoAlloc extern "C" value caml_result_set_set(value result,value p){
-// setResult ( *((results*) result), Int_val(p));
-// return (Val_unit);
-// }
-
-// NoAlloc extern "C" value caml_result_set_clear(value result,value p1,value p2){
-// clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
-// return (Val_unit);
-// }
-
-// NoAlloc extern "C" value caml_result_set_next(value result,value p){
-// results r;
-// r = *( (results *) result);
-// return (Val_int(nextResult(r, Int_val(p))));
-// }
-
-// NoAlloc extern "C" value caml_result_set_count(value result){
-// results r;
-// r = *( (results *) result);
-// return (Val_int(countResult(r)));
-// }
-
-NoAlloc extern "C" value caml_xml_tree_print(value tree,value node,value fd){
- CAMLparam3(tree,node,fd);
- XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node), false);
- CAMLreturn(Val_unit);
-}
-
-NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd){
- CAMLparam2(tree,fd);
- XMLTREE(tree)->Flush(Int_val(fd));
- CAMLreturn(Val_unit);
-}
-
-// NoAlloc extern "C" value caml_set_tag_bits(value result, value tag, value tree, value node)
-// {
-// results r;
-// XMLTree *t = XMLTREE(Field(tree,0));
-// treeNode opening = TREENODEVAL(node);
-// treeNode closing = t->Closing(opening);
-// TagType target_tag = Int_val(tag);
-// treeNode first = t->TaggedDescendant(opening,target_tag);
-// r = *( (results *) result);
-// opening = first;
-// while (opening != NULLT){
-// setResult(r,opening);
-// opening = t->TaggedFollowingBefore(opening,target_tag,closing);
-// };
-// return(Val_int(first));
-// }
-
-
-NoAlloc extern "C" value caml_bit_vector_create(value size){
- return (value) (new vector<bool>(Int_val(size),false));
-}
-
-NoAlloc extern "C" value caml_bit_vector_free(value vect){
- delete ((vector<bool>*) vect);
- return Val_unit;
-}
-
-NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){
- return Val_bool (((vector<bool>*)vect)->at(Int_val(idx)));
-}
-
-NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){
- (((vector<bool>*)vect)->at(Int_val(idx))) = (bool) Bool_val(b);
- return Val_unit;
-}
-
-NoAlloc extern "C" value caml_bit_vector_next(value vect,value idx){
- vector<bool>* bv = (vector<bool>*) vect;
- int i = Int_val(idx);
- int l = bv->size();
- while (i < l && !((*bv)[i]))
- i++;
- return Val_int(i);
-}
-NoAlloc extern "C" value caml_bit_vector_prev(value vect,value idx){
- int i = Int_val(idx);
- while (i >= 0 && !((*((vector<bool>*) vect))[i]))
- i--;
- return Val_int(i);
-}
-
-extern "C" value caml_bit_vector_node_array(value vect){
- CAMLparam0();
- CAMLlocal1(res);
- vector<bool>* bv = (vector<bool>*) vect;
- vector<treeNode> vr;
- int l = bv->size();
- int i = 0;
- while (i < l){
- if ((*bv)[i]) vr.push_back(i);
- i++;
- };
- l = vr.size();
- res = caml_alloc_tuple(l);
- for(i=0;i<l;i++)
- caml_initialize(&Field(res,i),Val_int(vr[i]));
- CAMLreturn (res);
-}
-
-
-int iterjump(XMLTree* tree, treeNode node, TagType tag, treeNode anc){
- if (node == NULLT)
- return 0;
- else {
- return
- 1
- + iterjump(tree,tree->TaggedDescendant(node,tag),tag,node)
- + iterjump(tree,tree->TaggedFollowingBelow(node,tag,anc),tag,anc);
- };
-}
-
-extern "C" value caml_benchmark_jump(value tree,value tag){
- int count;
- treeNode root = XMLTREE(tree)->FirstChild(0);
- root = XMLTREE(tree)->FirstChild(root);
- count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
- return Val_int(count);
-}
-
-int iterfcns(XMLTree* tree, treeNode node){
- if (node == NULLT)
- return 0;
- else {
- int tmp = 1;
- tmp += iterfcns(tree,tree->FirstChild(node));
- tmp += iterfcns(tree,tree->NextSibling(node));
-
- return tmp;
- };
-}
-
-int iterfene(XMLTree* tree, treeNode node){
- if (node == NULLT)
- return 0;
- else {
- int tmp = 1;
- tmp += iterfene(tree,tree->FirstElement(node));
- tmp += iterfene(tree,tree->NextElement(node));
- return tmp;
-
- };
-}
-
-extern "C" value caml_benchmark_fcns(value tree){
- int i = iterfcns(XMLTREE(tree),0);
- return Val_int(i);
-}
-
-extern "C" value caml_benchmark_fene(value tree){
- int i = iterfene(XMLTREE(tree),0);
- return Val_int(i);
-}
-
-int iterlcps(XMLTree* tree, treeNode node){
- if (node == NULLT)
- return 0;
- else {
- int x = tree->Tag(node);
- x += iterlcps(tree,tree->LastChild(node));
- x += iterlcps(tree,tree->PrevSibling(node));
- return x;
- };
-}
-
-int fulliterative(XMLTree* tree){
- treeNode current = tree->Root();
- treeNode next = NULLT;
- int count = 1; //the root
-
- do {
-
- while ((next = tree->FirstChild(current)) != NULLT) {
- current = next;
- count++;
- };
-
- while ( (next = tree->NextSibling(current)) == NULLT){
- current = tree->Parent(current);
- if (current == NULLT) return count;
- }
- current = next;
- count++;
- } while (true);
-
-}
-
-extern "C" value caml_benchmark_iter(value tree){
- return Val_int(fulliterative(XMLTREE(tree)));
-}
-
-extern "C" value caml_benchmark_lcps(value tree){
-
- iterlcps(XMLTREE(tree),0);
- return Val_unit;
-
-}
-
-extern "C" {
-
- typedef struct dummy_node_ {
- struct dummy_node_* first;
- struct dummy_node_* next;
- } dummy_node;
-
-
- dummy_node * new_dummy_node () {
-
- dummy_node * node = (dummy_node*) malloc(sizeof(dummy_node));
- if (!node)
- printf("%s","Cannot allocate memory\n");
-
- return node;
- }
-
- void free_tree(dummy_node * node){
- if (node){
- free_tree(node->first);
- free_tree(node->next);
- free(node);
- };
- return;
- }
-
- dummy_node * create_tree(XMLTree* tree, treeNode i, int mode){
- if (i == NULLT)
- return NULL;
- else {
- dummy_node * f, *n, *r;
- //mode = i % 3;
- r = NULL;
- if (mode == 0) r = new_dummy_node();
- f = create_tree(tree,tree->FirstChild(i), mode);
- if (mode == 1) r = new_dummy_node();
- n = create_tree(tree,tree->NextSibling(i), mode);
- if (mode == 2) r = new_dummy_node();
- r->first = f;
- r->next = n;
- return r;
- };
- }
-
- int iter_tree(dummy_node * n){
- if (n == NULL)
- return 0;
- else
- return 1 + iter_tree (n->first) + iter_tree (n->next);
- }
-}
-extern "C" value caml_build_pointers(value tree, value mode){
- return ((value) create_tree(XMLTREE(Field(tree,0)),0, Int_val(mode)));
-}
-
-extern "C" value caml_iter_pointers (value node){
- return Val_int(iter_tree((dummy_node*) node));
-
-}
-
-extern "C" value caml_free_pointers(value node){
- free_tree((dummy_node*) node);
- return Val_unit;
-}
/**
* Interface to the TextCollection
*/
CAMLreturn (str);
}
-
extern "C" value caml_text_collection_empty_text(value tree,value id){
CAMLparam2(tree,id);
CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
CAMLreturn (sort_alloc_array(results,resarray));
}
-/** Full reporting into a bit vector
- */
-static std::vector<DocID> sort_results(std::vector<DocID> v)
-{
- std::vector<DocID> res;
- std::sort(v.begin(), v.end());
- DocID prev = NULLT;
- for(auto i = v.begin(); i != v.end(); ++i){
- while (prev == *i){
- ++i;
- if (i == v.end()) return res;
- };
- prev = *i;
- res.push_back(prev);
- };
- return res;
-}
-
-#define BV_QUERY(pref, Pref) \
- extern "C" value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
- CAMLparam3(tree, str, dobvv); \
- CAMLlocal3(res, res_bv, res_array); \
- int j; \
- uchar * cstr = (uchar *) strdup(String_val(str)); \
- std::vector<DocID> uresults = XMLTREE(tree)->Pref(cstr); \
- std::vector<DocID> results = sort_results(uresults); \
- bool dobv = Bool_val(dobvv); \
- res_bv = caml_alloc_string(dobv ? ((XMLTREE(tree)->Size() / 4) + 2) : 0); \
- unsigned long slen = caml_string_length(res_bv); \
- if (dobv) \
- memset(&(Byte(res_bv,0)), 0, slen); \
- res_array = caml_alloc_shr(results.size(), 0); \
- for (unsigned int i = 0; i < results.size(); ++i) { \
- j = XMLTREE(tree)->ParentNode(results[i]); \
- if (dobv) { \
- Byte(res_bv, j >> 3) |= (1 << (j & 7)); \
- }; \
- caml_initialize(&Field(res_array, i), Val_int(j)); \
- }; \
- free(cstr); \
- res = caml_alloc(2, 0); \
- Store_field(res, 0, res_bv); \
- Store_field(res, 1, res_array); \
- CAMLreturn(res); \
- } \
-
-
-BV_QUERY(prefix, Prefix)
-BV_QUERY(suffix, Suffix)
-BV_QUERY(equals, Equals)
-BV_QUERY(contains, Contains)
-BV_QUERY(lessthan, LessThan)
-
////////////////////// BP
--- /dev/null
+#include <unordered_set>
+#include "xml-tree.hpp"
+#include "common_stub.hpp"
+
+using namespace SXSI;
+
+static xml_tree*& XMLTREE(value v)
+{
+ return Obj_val<xml_tree*>(v);
+}
+
+static xml_tree::node_t TREENODE(value i)
+{
+ return static_cast<xml_tree::node_t>(Int_val(i));
+}
+
+static xml_tree::tag_t TAG(value i)
+{
+ return static_cast<xml_tree::tag_t>(Int_val(i));
+}
+
+static std::unordered_set<xml_tree::tag_t>*& HSET(value x)
+{
+ return Obj_val<std::unordered_set<xml_tree::tag_t>*>(x);
+}
+
+
+NoAlloc extern "C" value caml_unordered_set_length(value hset)
+{
+ return (Val_int((HSET(hset))->size()));
+}
+
+extern "C" value caml_unordered_set_alloc(value unit)
+{
+ CAMLparam1(unit);
+ CAMLlocal1(hset);
+ hset = sxsi_alloc_custom<std::unordered_set<xml_tree::tag_t>*>();
+ HSET(hset) = new std::unordered_set<xml_tree::tag_t>();
+ CAMLreturn (hset);
+}
+
+NoAlloc extern "C" value caml_unordered_set_set(value set, value v)
+{
+ HSET(set)->insert(TAG(v));
+ return (Val_unit);
+}
+
+extern "C" value caml_xml_tree_save(value tree, value fd, value prefix)
+{
+ CAMLparam3(tree, fd, prefix);
+ XMLTREE(tree)->save(Int_val(fd), String_val(prefix));
+ CAMLreturn (Val_unit);
+}
+
+extern "C" value
+caml_xml_tree_load(value fd, value prefix, value load_tc, value sf)
+{
+ CAMLparam4(fd, prefix, load_tc, sf);
+ CAMLlocal1(result);
+ xml_tree * tree;
+ try {
+
+ tree = xml_tree::load(Int_val(fd),
+ String_val(prefix),
+ Bool_val(load_tc),
+ Int_val(sf));
+
+ result = sxsi_alloc_custom<xml_tree*>();
+ XMLTREE(result) = tree;
+ CAMLreturn(result);
+ }
+ catch (const std::exception& e){ sxsi_raise_msg(e.what()); }
+ catch (std::string msg){ sxsi_raise_msg(msg.c_str()); }
+ catch (char const * msg){ sxsi_raise_msg(msg); };
+ //never reached
+ return (Val_unit);
+}
+
+NoAlloc extern "C" value caml_xml_tree_root(value tree)
+{
+ return (Val_int(XMLTREE(tree)->root()));
+}
+
+NoAlloc extern "C" value caml_xml_tree_size(value tree)
+{
+ return (Val_int(XMLTREE(tree)->size()));
+}
+
+NoAlloc extern "C" value caml_xml_tree_num_tags(value tree)
+{
+ return (Val_int(XMLTREE(tree)->num_tags()));
+}
+
+NoAlloc extern "C" value caml_xml_tree_subtree_size(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->subtree_size(TREENODE(node))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_subtree_tags(value tree, value node, value tag)
+{
+ return (Val_int(XMLTREE(tree)->subtree_tags(TREENODE(node),
+ TAG(tag))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->subtree_elements(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
+ return (Val_bool(XMLTREE(tree)->is_leaf(TREENODE(node))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_is_ancestor(value tree, value node1, value node2)
+{
+ return (Val_bool(XMLTREE(tree)->is_ancestor(TREENODE(node1),
+ TREENODE(node2))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_is_child(value tree, value node1, value node2)
+{
+ return (Val_bool(XMLTREE(tree)->is_child(TREENODE(node1),
+ TREENODE(node2))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node)
+{
+ return (Val_bool(XMLTREE(tree)->is_first_child(TREENODE(node))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_is_right_descendant(value tree, value x, value y)
+{
+ return (Val_bool(XMLTREE(tree)->is_right_descendant(TREENODE(x),
+ TREENODE(y))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_num_children(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->num_children(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_child_pos(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->child_pos(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_depth(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->depth(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_preorder(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->preorder(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_postorder(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->postorder(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_tag(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->tag(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_parent(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->parent(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_child(value tree, value node, value idx)
+{
+ return (Val_int(XMLTREE(tree)->child(TREENODE(node), Int_val(idx))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_first_child(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->first_child(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_first_element(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->first_element(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_last_child(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->last_child(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_next_sibling(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->next_sibling(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->next_element(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->prev_sibling(TREENODE(node))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_tagged_child(value tree, value node, value tag)
+{
+ return (Val_int(XMLTREE(tree)->tagged_child(TREENODE(node),
+ TAG(tag))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_select_child(value tree, value node, value tags)
+{
+ return (Val_int(XMLTREE(tree)->select_child(TREENODE(node), HSET(tags))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_tagged_sibling(value tree, value node, value tag)
+{
+ return (Val_int(XMLTREE(tree)->tagged_sibling(TREENODE(node),
+ TAG(tag))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_select_sibling(value tree, value node, value tags)
+{
+ return (Val_int(XMLTREE(tree)->select_sibling(TREENODE(node),
+ HSET(tags))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_tagged_descendant(value tree, value node, value tag)
+{
+ return (Val_int(XMLTREE(tree)->tagged_descendant(TREENODE(node),
+ TAG(tag))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_tagged_next(value tree, value node, value tag)
+{
+ return (Val_int(XMLTREE(tree)->tagged_next(TREENODE(node),
+ TAG(tag))));
+}
+
+NoAlloc extern "C" value
+caml_xml_tree_select_descendant(value tree, value node, value tags)
+{
+ return (Val_int(XMLTREE(tree)->select_descendant(TREENODE(node),
+ HSET(tags))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree,
+ value node,
+ value tag,
+ value closing)
+{
+ return (Val_int(XMLTREE(tree)->tagged_following_before(TREENODE(node),
+ TAG(tag),
+ TREENODE(closing))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_select_following_before(value tree,
+ value node,
+ value tags,
+ value closing)
+{
+ return (Val_int(XMLTREE(tree)->select_following_before(TREENODE(node),
+ HSET(tags),
+ TREENODE(closing))));
+}
+
+
+
+extern "C" value caml_xml_tree_get_text_collection(value tree)
+{
+ CAMLparam1(tree);
+ CAMLlocal1(text);
+ text = sxsi_alloc_custom<TextCollection*>();
+ Obj_val<TextCollection*>(text) = XMLTREE(tree)->get_text_collection();
+ CAMLreturn (text);
+}
+
+NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node)
+{
+ return (Val_int(XMLTREE(tree)->closing(TREENODE(node))));
+}
+
+NoAlloc extern "C" value caml_xml_tree_nullt(value unit){
+ return (Val_int(xml_tree::NIL));
+}
+
+
+extern "C" value caml_xml_tree_print(value tree, value node, value fd)
+{
+ CAMLparam3(tree, node, fd);
+ XMLTREE(tree)->print(TREENODE(node), Int_val(fd));
+ CAMLreturn(Val_unit);
+}
+
+
+extern "C" value caml_xml_tree_get_tag_name(value tree, value tag)
+{
+ CAMLparam2(tree, tag);
+ CAMLlocal1(res);
+ const char* s = XMLTREE(tree)->get_tag_name_by_ref(TAG(tag));
+ res = caml_copy_string(s);
+ CAMLreturn(res);
+}
+
+NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd)
+{
+ XMLTREE(tree)->flush(Int_val(fd));
+ return Val_unit;
+}
+
+extern "C" value caml_xml_tree_register_tag(value tree, value str)
+{
+ CAMLparam2(tree, str);
+ value res;
+ res = Val_int(XMLTREE(tree)->register_tag(String_val(str)));
+ CAMLreturn(res);
+}
+
+
+/** Full reporting into a bit vector
+ */
+static std::vector<int32_t> sort_results(std::vector<int32_t> v)
+{
+ std::vector<int32_t> res;
+ std::sort(v.begin(), v.end());
+ int32_t prev = -1;
+ for(auto i = v.begin(); i != v.end(); ++i){
+ while (prev == *i){
+ ++i;
+ if (i == v.end()) return res;
+ };
+ prev = *i;
+ res.push_back(prev);
+ };
+ return res;
+}
+
+#define BV_QUERY(pref, Pref) \
+ extern "C" value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
+ CAMLparam3(tree, str, dobvv); \
+ CAMLlocal3(res, res_bv, res_array); \
+ int j; \
+ uchar * cstr = (uchar *) strdup(String_val(str)); \
+ std::vector<int32_t> uresults = XMLTREE(tree)->Pref(cstr); \
+ std::vector<int32_t> results = sort_results(uresults); \
+ bool dobv = Bool_val(dobvv); \
+ res_bv = caml_alloc_string(dobv ? ((XMLTREE(tree)->size() / 4) + 2) : 0); \
+ unsigned long slen = caml_string_length(res_bv); \
+ if (dobv) \
+ memset(&(Byte(res_bv,0)), 0, slen); \
+ res_array = caml_alloc_shr(results.size(), 0); \
+ for (unsigned int i = 0; i < results.size(); ++i) { \
+ j = XMLTREE(tree)->parent_node(results[i]); \
+ if (dobv) { \
+ Byte(res_bv, j >> 3) |= (1 << (j & 7)); \
+ }; \
+ caml_initialize(&Field(res_array, i), Val_int(j)); \
+ }; \
+ free(cstr); \
+ res = caml_alloc(2, 0); \
+ Store_field(res, 0, res_bv); \
+ Store_field(res, 1, res_array); \
+ CAMLreturn(res); \
+ } \
+
+
+BV_QUERY(prefix, prefix)
+BV_QUERY(suffix, suffix)
+BV_QUERY(equals, equals)
+BV_QUERY(contains, contains)
+BV_QUERY(lessthan, less_than)