From 9d19c60e10c9572885509b35c2b72f362968d6ab Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Wed, 4 Apr 2012 19:07:23 +0200 Subject: [PATCH] Big refactoring of libxml-tree, part (1) (everything compiles) --- configure | 4 +- src/OCamlDriver.cpp | 711 ---------------------------------- src/common_stub.cpp | 2 +- src/common_stub.hpp | 7 +- src/l2JIT.ml | 12 +- src/l2JIT.mli | 4 +- src/libcamlshredder.clib | 2 + src/runtime.ml | 8 +- src/tree.ml | 22 +- src/tree.mli | 6 +- src/xml-tree-builder_stub.cpp | 84 ++++ src/xml-tree_stub.cpp | 383 ++++++++++++++++++ 12 files changed, 498 insertions(+), 747 deletions(-) create mode 100644 src/xml-tree-builder_stub.cpp create mode 100644 src/xml-tree_stub.cpp diff --git a/configure b/configure index e53f053..a9eccc8 100755 --- a/configure +++ b/configure @@ -20,7 +20,7 @@ Conf.check_prog "expat" "ocamlfind query expat";; Conf.check "bp" (Conf.absolute) ("%s/../bp/libbp.a") (Sys.file_exists);; Conf.check "libcds" (Conf.absolute) ("%s/../libcds/lib/libcds.a") (Sys.file_exists);; -Conf.check "XMLTree" (Conf.absolute) ("%s/../XMLTree/libXMLTree.a") (Sys.file_exists);; +Conf.check "libxml-tree" (Conf.absolute) ("%s/../XMLTree/libxml-tree.a") (Sys.file_exists);; Conf.check "TextCollection" (Conf.absolute) ("%s/../TextCollection/libTextCollection.a") (Sys.file_exists);; @@ -42,7 +42,7 @@ let libs_L = [ (* Order is relevant *) let libs_l = [ - "-lXMLTree"; + "-lxml-tree"; "-lTextCollection"; "-lbp"; "-lcds" diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index b93286c..223f3e3 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -55,664 +55,7 @@ extern "C" value caml_leading_bit(value i) 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(); - 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: - 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(); - Obj_val(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(); - Obj_val(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(); - Obj_val(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(Int_val(size),false)); -} - -NoAlloc extern "C" value caml_bit_vector_free(value vect){ - delete ((vector*) vect); - return Val_unit; -} - -NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){ - return Val_bool (((vector*)vect)->at(Int_val(idx))); -} - -NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){ - (((vector*)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* bv = (vector*) 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*) vect))[i])) - i--; - return Val_int(i); -} - -extern "C" value caml_bit_vector_node_array(value vect){ - CAMLparam0(); - CAMLlocal1(res); - vector* bv = (vector*) vect; - vector 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;iTaggedDescendant(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 */ @@ -729,7 +72,6 @@ extern "C" value caml_text_collection_get_text(value tree, value id){ 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)))); @@ -869,59 +211,6 @@ extern "C" value caml_text_collection_lessthan(value tree,value str){ CAMLreturn (sort_alloc_array(results,resarray)); } -/** Full reporting into a bit vector - */ -static std::vector sort_results(std::vector v) -{ - std::vector 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 uresults = XMLTREE(tree)->Pref(cstr); \ - std::vector 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 diff --git a/src/common_stub.cpp b/src/common_stub.cpp index 12b354e..85be940 100644 --- a/src/common_stub.cpp +++ b/src/common_stub.cpp @@ -88,7 +88,7 @@ extern "C" value sxsi_cpp_init(value unit) return Val_unit; } -void sxsi_raise_msg(char * msg) +void sxsi_raise_msg(const char * msg) { if (cpp_exception == 0) init_error(); caml_raise_with_string(*cpp_exception, msg); diff --git a/src/common_stub.hpp b/src/common_stub.hpp index 47b6dcd..ad15256 100644 --- a/src/common_stub.hpp +++ b/src/common_stub.hpp @@ -14,6 +14,8 @@ extern "C" { } #include +#define NoAlloc + void register_custom_(char* name, size_t size, @@ -38,7 +40,8 @@ template void sxsi_finalize_custom(value v) sxsi_finalize_obj(Obj_val(v)); } -template value sxsi_alloc_custom(void (*finalize)(value) = sxsi_finalize_custom) +template value +sxsi_alloc_custom(void (*finalize)(value) = sxsi_finalize_custom) { char * name = const_cast(typeid(X).name()); @@ -50,7 +53,7 @@ template value sxsi_alloc_custom(void (*finalize)(value) = sxsi_finali return v; } -void sxsi_raise_msg(char * msg); +void sxsi_raise_msg(const char * msg); extern "C" value sxsi_cpp_init(value unit); diff --git a/src/l2JIT.ml b/src/l2JIT.ml index 90105d8..b656faf 100644 --- a/src/l2JIT.ml +++ b/src/l2JIT.ml @@ -16,9 +16,9 @@ type jump = | SELECT_DESCENDANT of StateSet.t * Ptset.Int.t * Tree.unordered_set | SELECT_FOLLOWING of StateSet.t * Ptset.Int.t * Tree.unordered_set | TAGGED_CHILD of StateSet.t * Tag.t - | TAGGED_FOLLOWING_SIBLING of StateSet.t * Tag.t + | TAGGED_SIBLING of StateSet.t * Tag.t | SELECT_CHILD of StateSet.t * Ptset.Int.t * Tree.unordered_set - | SELECT_FOLLOWING_SIBLING of StateSet.t * Ptset.Int.t * Tree.unordered_set + | SELECT_SIBLING of StateSet.t * Ptset.Int.t * Tree.unordered_set | TAGGED_SUBTREE of StateSet.t * Tag.t | ELEMENT_SUBTREE of StateSet.t @@ -34,9 +34,9 @@ let _tagged_following s t = TAGGED_FOLLOWING(s,t) let _select_descendant s t = SELECT_DESCENDANT(s,t, Tree.unordered_set_of_set t) let _select_following s t = SELECT_FOLLOWING(s,t, Tree.unordered_set_of_set t) let _tagged_child s t = TAGGED_CHILD(s,t) -let _tagged_following_sibling s t = TAGGED_FOLLOWING_SIBLING(s,t) +let _tagged_following_sibling s t = TAGGED_SIBLING(s,t) let _select_child s t = SELECT_CHILD(s,t, Tree.unordered_set_of_set t) -let _select_following_sibling s t = SELECT_FOLLOWING_SIBLING(s,t, Tree.unordered_set_of_set t) +let _select_following_sibling s t = SELECT_SIBLING(s,t, Tree.unordered_set_of_set t) let _tagged_subtree s t = TAGGED_SUBTREE (s, t) let _element_subtree s = ELEMENT_SUBTREE s @@ -67,13 +67,13 @@ let print_jump fmt j = | TAGGED_CHILD (_, tag) -> fprintf fmt "tagged_child(%s)" (Tag.to_string tag) - | TAGGED_FOLLOWING_SIBLING (_, tag) -> + | TAGGED_SIBLING (_, tag) -> fprintf fmt "tagged_following_sibling(%s)" (Tag.to_string tag) | SELECT_CHILD (_, tags, _) -> fprintf fmt "select_child(%a)" TagSet.print (TagSet.inj_positive tags) - | SELECT_FOLLOWING_SIBLING (_, tags, _) -> fprintf fmt "select_following_sibling(%a)" + | SELECT_SIBLING (_, tags, _) -> fprintf fmt "select_following_sibling(%a)" TagSet.print (TagSet.inj_positive tags) | TAGGED_SUBTREE (_, tag) -> fprintf fmt "tagged_subtree(%s)" (Tag.to_string tag) diff --git a/src/l2JIT.mli b/src/l2JIT.mli index e6f3aa9..f269fc6 100644 --- a/src/l2JIT.mli +++ b/src/l2JIT.mli @@ -9,9 +9,9 @@ type jump = | SELECT_DESCENDANT of StateSet.t * Ptset.Int.t * Tree.unordered_set | SELECT_FOLLOWING of StateSet.t * Ptset.Int.t * Tree.unordered_set | TAGGED_CHILD of StateSet.t * Tag.t - | TAGGED_FOLLOWING_SIBLING of StateSet.t * Tag.t + | TAGGED_SIBLING of StateSet.t * Tag.t | SELECT_CHILD of StateSet.t * Ptset.Int.t * Tree.unordered_set - | SELECT_FOLLOWING_SIBLING of StateSet.t * Ptset.Int.t * Tree.unordered_set + | SELECT_SIBLING of StateSet.t * Ptset.Int.t * Tree.unordered_set | TAGGED_SUBTREE of StateSet.t * Tag.t | ELEMENT_SUBTREE of StateSet.t diff --git a/src/libcamlshredder.clib b/src/libcamlshredder.clib index 5a8dd8b..ccb0db4 100644 --- a/src/libcamlshredder.clib +++ b/src/libcamlshredder.clib @@ -1,2 +1,4 @@ OCamlDriver.o +xml-tree-builder_stub.o +xml-tree_stub.o common_stub.o diff --git a/src/runtime.ml b/src/runtime.ml index bc771eb..a7103f1 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -277,14 +277,14 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = ( | L2JIT.TAGGED_CHILD (s, tag) -> LOOP_TAG((Tree.tagged_child tree t tag), s, tag, ctx) - | L2JIT.TAGGED_FOLLOWING_SIBLING (s, tag) -> - LOOP_TAG((Tree.tagged_following_sibling tree t tag), s, tag, ctx) + | L2JIT.TAGGED_SIBLING (s, tag) -> + LOOP_TAG((Tree.tagged_sibling tree t tag), s, tag, ctx) | L2JIT.SELECT_CHILD (s, _, us) -> LOOP ((Tree.select_child tree t us), s, ctx) - | L2JIT.SELECT_FOLLOWING_SIBLING (s, _, us) -> - LOOP ((Tree.select_following_sibling tree t us), s, ctx) + | L2JIT.SELECT_SIBLING (s, _, us) -> + LOOP ((Tree.select_sibling tree t us), s, ctx) | L2JIT.TAGGED_SUBTREE(s, tag) -> mark_subtree s (U.NS.subtree_tags tree t tag) diff --git a/src/tree.ml b/src/tree.ml index 66bf159..10a499d 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -53,9 +53,9 @@ struct external create : unit -> t = "caml_xml_tree_builder_create" external open_document : t -> bool -> int -> bool -> int -> unit = "caml_xml_tree_builder_open_document" external close_document : t -> tree = "caml_xml_tree_builder_close_document" - external open_tag : t -> string -> unit = "caml_xml_tree_builder_new_open_tag" - external close_tag : t -> string -> unit = "caml_xml_tree_builder_new_closing_tag" - external text : t -> string -> unit = "caml_xml_tree_builder_new_text" + external open_tag : t -> string -> unit = "caml_xml_tree_builder_open_tag" + external close_tag : t -> string -> unit = "caml_xml_tree_builder_close_tag" + external text : t -> string -> unit = "caml_xml_tree_builder_text" let is_whitespace s = let rec loop len i = @@ -264,14 +264,11 @@ let next_sibling t n = tree_next_sibling t.doc n external tree_next_element : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_element" "noalloc" let next_element t n = tree_next_element t.doc n -external tree_next_node_before : tree -> [`Tree] Node.t -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_node_before" "noalloc" -let next_node_before t n ctx = tree_next_node_before t.doc n ctx +external tree_tagged_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_sibling" "noalloc" +let tagged_sibling t n tag = tree_tagged_sibling t.doc n tag -external tree_tagged_following_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_following_sibling" "noalloc" -let tagged_following_sibling t n tag = tree_tagged_following_sibling t.doc n tag - -external tree_select_following_sibling : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t = "caml_xml_tree_select_following_sibling" "noalloc" -let select_following_sibling t n tag_set = tree_select_following_sibling t.doc n tag_set +external tree_select_sibling : tree -> [`Tree ] Node.t -> unordered_set -> [`Tree] Node.t = "caml_xml_tree_select_sibling" "noalloc" +let select_sibling t n tag_set = tree_select_sibling t.doc n tag_set external tree_prev_sibling : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_prev_sibling" "noalloc" let prev_sibling t n = tree_prev_sibling t.doc n @@ -296,11 +293,6 @@ let select_following_before t n tag_set ctx = tree_select_following_before t.doc external tree_parent : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_parent" "noalloc" let parent t n = tree_parent t.doc n -external tree_binary_parent : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_binary_parent" - "noalloc" -let binary_parent t n = tree_binary_parent t.doc n - - external tree_tag : tree -> [`Tree] Node.t -> Tag.t = "caml_xml_tree_tag" "noalloc" let tag t n = tree_tag t.doc n diff --git a/src/tree.mli b/src/tree.mli index 0946a4c..ee9a5f4 100644 --- a/src/tree.mli +++ b/src/tree.mli @@ -28,9 +28,8 @@ val select_child : t -> node -> unordered_set -> node val next_sibling : t -> node -> node val prev_sibling : t -> node -> node val next_element : t -> node -> node -val next_node_before : t -> node -> node -> node -val tagged_following_sibling : t -> node -> Tag.t -> node -val select_following_sibling : t -> node -> unordered_set -> node +val tagged_sibling : t -> node -> Tag.t -> node +val select_sibling : t -> node -> unordered_set -> node val tagged_descendant : t -> node -> Tag.t -> node val tagged_next : t -> node -> Tag.t -> node @@ -40,7 +39,6 @@ val tagged_following_before : t -> node -> Tag.t -> node -> node val select_following_before : t -> node -> unordered_set -> node -> node val parent : t -> node -> node -val binary_parent : t -> node -> node val is_first_child : t -> node -> bool val is_right_descendant : t -> node -> node -> bool diff --git a/src/xml-tree-builder_stub.cpp b/src/xml-tree-builder_stub.cpp new file mode 100644 index 0000000..6fc1c60 --- /dev/null +++ b/src/xml-tree-builder_stub.cpp @@ -0,0 +1,84 @@ +#include "xml-tree-builder.hpp" +#include "common_stub.hpp" + +using namespace SXSI; + +static xml_tree_builder*& OBJ_VAL(value v) +{ + return Obj_val(v); +} + +extern "C" value caml_xml_tree_builder_create(value unit) +{ + CAMLparam1(unit); + CAMLlocal1(result); + result = sxsi_alloc_custom(); + OBJ_VAL(result) = new xml_tree_builder(); + + CAMLreturn(result); +} + +extern "C" value caml_xml_tree_builder_open_document(value vbuilder, + value vsrate, + value vdtc, + value vidxtype) +{ + CAMLparam4(vbuilder, vsrate, vdtc, vidxtype); + 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: + sxsi_raise_msg("Invalid Index Type"); + }; + + OBJ_VAL(vbuilder)->open_document(disable_tc, + sample_rate, + idx_type); + CAMLreturn (Val_unit); +} + +extern "C" value caml_xml_tree_builder_close_document(value vbuilder) +{ + CAMLparam1(vbuilder); + CAMLlocal1(result); + xml_tree *tree = OBJ_VAL(vbuilder)->close_document(); + if (tree == NULL) + sxsi_raise_msg("caml_close_document"); + result = sxsi_alloc_custom(); + Obj_val(result) = tree; + CAMLreturn (result); +} + +extern "C" value caml_xml_tree_builder_open_tag(value vbuilder, value vtag) +{ + CAMLparam2(vbuilder, vtag); + const char * tag = String_val(vtag); + OBJ_VAL(vbuilder)->open_tag(std::string(tag)); + CAMLreturn (Val_unit); +} + +extern "C" value caml_xml_tree_builder_close_tag(value vbuilder, value vtag) +{ + CAMLparam2(vbuilder, vtag); + const char * tag = String_val(vtag); + OBJ_VAL(vbuilder)->close_tag(std::string(tag)); + CAMLreturn (Val_unit); +} + +extern "C" value caml_xml_tree_builder_text(value vbuilder, value vtext) +{ + CAMLparam2(vbuilder, vtext); + const char * text = String_val(vtext); + OBJ_VAL(vbuilder)->text(std::string(text)); + CAMLreturn (Val_unit); +} diff --git a/src/xml-tree_stub.cpp b/src/xml-tree_stub.cpp new file mode 100644 index 0000000..cdb7fe1 --- /dev/null +++ b/src/xml-tree_stub.cpp @@ -0,0 +1,383 @@ +#include +#include "xml-tree.hpp" +#include "common_stub.hpp" + +using namespace SXSI; + +static xml_tree*& XMLTREE(value v) +{ + return Obj_val(v); +} + +static xml_tree::node_t TREENODE(value i) +{ + return static_cast(Int_val(i)); +} + +static xml_tree::tag_t TAG(value i) +{ + return static_cast(Int_val(i)); +} + +static std::unordered_set*& HSET(value x) +{ + return Obj_val*>(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*>(); + HSET(hset) = new std::unordered_set(); + 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(); + 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(); + Obj_val(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 sort_results(std::vector v) +{ + std::vector 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 uresults = XMLTREE(tree)->Pref(cstr); \ + std::vector 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) -- 2.17.1