X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FOCamlDriver.cpp;h=146a0dfbc878bf9ff5458736ca250c6fad411ddc;hb=1975eef2d0933da3c01faec1cd14bc8fbf6bf146;hp=8eb3a22ce681aaef83cfa7d9839535adb93dbea3;hpb=ff13d22656fdbdffb2d909192bd17ba135606224;p=SXSI%2Fxpathcomp.git diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index 8eb3a22..146a0df 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -20,20 +20,19 @@ #include "XMLTree.h" #include "XMLTreeBuilder.h" +#include "Grammar.h" #include "Utils.h" #include "common_stub.hpp" -extern "C" { -#include -} - #define CAMLRAISEMSG(msg) (sxsi_raise_msg((char*) (msg))) -#define XMLTREE(x) (Obj_val(x)) +#define XMLTREE(x) (Obj_val(x)) -#define HSET(x) (Obj_val(x)) +#define HSET(x) (Obj_val(x)) -#define XMLTREEBUILDER(x) (Obj_val(x)) +#define XMLTREEBUILDER(x) (Obj_val(x)) + +#define GRAMMAR(x) (Obj_val(x)) #define TREENODEVAL(i) ((treeNode) (Int_val(i))) @@ -44,6 +43,7 @@ extern "C" { extern "C" { #include #include +#include } @@ -56,8 +56,9 @@ extern "C" value caml_xml_tree_builder_create(value unit) { CAMLparam1(unit); CAMLlocal1(result); - result = sxsi_alloc_custom(); - Obj_val(result) = new XMLTreeBuilder(); + result = sxsi_alloc_custom(); + Obj_val(result) = new XMLTreeBuilder(); + CAMLreturn(result); } @@ -102,8 +103,8 @@ extern "C" value caml_xml_tree_builder_close_document(value vbuilder) XMLTree * tree = XMLTREEBUILDER(vbuilder)->CloseDocument(); if (tree == NULL) CAMLRAISEMSG("CloseDocument"); - result = sxsi_alloc_custom(); - Obj_val(result) = tree; + result = sxsi_alloc_custom(); + Obj_val(result) = tree; CAMLreturn (result); } @@ -158,9 +159,10 @@ extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value s 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; + result = sxsi_alloc_custom(); + Obj_val(result) = tree; CAMLreturn(result); } catch (const std::exception& e){ CAMLRAISEMSG(e.what()); } @@ -280,6 +282,10 @@ 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)))); } @@ -416,8 +422,8 @@ NoAlloc extern "C" value caml_unordered_set_length(value hset){ extern "C" value caml_unordered_set_alloc(value unit){ CAMLparam1(unit); CAMLlocal1(hset); - hset = sxsi_alloc_custom(); - Obj_val(hset) = new TagIdSet(); + hset = sxsi_alloc_custom(); + Obj_val(hset) = new TagIdSet(); CAMLreturn (hset); } @@ -888,3 +894,266 @@ BV_QUERY(suffix, Suffix) BV_QUERY(equals, Equals) BV_QUERY(contains, Contains) BV_QUERY(lessthan, LessThan) + + + +//////////////////////////////////////////// Grammar stuff + +extern "C" value caml_grammar_load(value file, value load_bp) +{ + CAMLparam2(file, load_bp); + CAMLlocal1(result); + Grammar *grammar; + int f1 = Int_val(file); + int f2 = dup(f1); + FILE * fd = fdopen(f2, "r"); + if (fd == NULL) + CAMLRAISEMSG("Error opening grammar file"); + grammar = Grammar::load(fd, Bool_val(load_bp)); + fclose(fd); + result = sxsi_alloc_custom(); + Obj_val(result) = grammar; + CAMLreturn(result); +} + +extern "C" value caml_grammar_get_symbol_at(value grammar, value symbol, value preorder) +{ + CAMLparam3(grammar, symbol, preorder); + CAMLreturn(Val_long(GRAMMAR(grammar)->getSymbolAt(Long_val(symbol), Int_val(preorder)))); +} + +extern "C" value caml_grammar_first_child(value grammar, value rule, value pos) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->firstChild(Long_val(rule), Int_val(pos)))); +} + +extern "C" value caml_grammar_next_sibling(value grammar, value rule, value pos) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->nextSibling(Long_val(rule), Int_val(pos)))); +} + +extern "C" value caml_grammar_start_first_child(value grammar, value pos) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->startFirstChild(Int_val(pos)))); +} + +extern "C" value caml_grammar_start_next_sibling(value grammar, value pos) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->startNextSibling(Int_val(pos)))); +} + +extern "C" value caml_grammar_is_nil(value grammar, value rule) +{ + CAMLparam1(grammar); + CAMLreturn(Val_bool(GRAMMAR(grammar)->isNil(Long_val(rule)))); +} + +extern "C" value caml_grammar_get_tag(value grammar, value tag) +{ + CAMLparam1(grammar); + CAMLlocal1(res); + const char * s = (GRAMMAR(grammar)->getTagName(Long_val(tag))).c_str(); + res = caml_copy_string(s); + CAMLreturn(res); +} + +extern "C" value caml_grammar_get_id1(value grammar, value rule) +{ + CAMLparam1(grammar); + CAMLreturn(Val_long(GRAMMAR(grammar)->getID1(Long_val(rule)))); +} + +extern "C" value caml_grammar_get_id2(value grammar, value rule) +{ + CAMLparam1(grammar); + CAMLreturn(Val_long(GRAMMAR(grammar)->getID2(Long_val(rule)))); +} + +extern "C" value caml_grammar_get_param_pos(value grammar, value rule) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->getParamPos(Long_val(rule)))); +} + +extern "C" value caml_grammar_translate_tag(value grammar, value tag) +{ + CAMLparam1(grammar); + CAMLreturn(Val_int(GRAMMAR(grammar)->translateTag(Int_val(tag)))); +} + +extern "C" value caml_grammar_register_tag(value grammar, value str) +{ + CAMLparam2(grammar, str); + char * s = String_val(str); + CAMLreturn(Val_int(GRAMMAR(grammar)->getTagID(s))); +} + +extern "C" value caml_grammar_nil_id(value grammar) +{ + CAMLparam1(grammar); + CAMLreturn(Val_long((GRAMMAR(grammar)->getNiltagid()) * 4 + 1)); +} + +extern "C" { +extern char *caml_young_end; +extern char *caml_young_start; +typedef char * addr; +#define Is_young(val) \ + ((addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start) + +} +extern "C" value caml_custom_is_young(value a){ + return Val_bool(Is_young(a)); +} + +extern "C" value caml_custom_array_blit(value a1, value ofs1, value a2, value ofs2, + value n) +{ + value * src, * dst; + intnat count; + + if (Is_young(a2)) { + /* Arrays of values, destination is in young generation. + Here too we can do a direct copy since this cannot create + old-to-young pointers, nor mess up with the incremental major GC. + Again, memmove takes care of overlap. */ + memmove(&Field(a2, Long_val(ofs2)), + &Field(a1, Long_val(ofs1)), + Long_val(n) * sizeof(value)); + return Val_unit; + } + /* Array of values, destination is in old generation. + We must use caml_modify. */ + count = Long_val(n); + if (a1 == a2 && Long_val(ofs1) < Long_val(ofs2)) { + /* Copy in descending order */ + for (dst = &Field(a2, Long_val(ofs2) + count - 1), + src = &Field(a1, Long_val(ofs1) + count - 1); + count > 0; + count--, src--, dst--) { + caml_modify(dst, *src); + } + } else { + /* Copy in ascending order */ + for (dst = &Field(a2, Long_val(ofs2)), src = &Field(a1, Long_val(ofs1)); + count > 0; + count--, src++, dst++) { + caml_modify(dst, *src); + } + } + /* Many caml_modify in a row can create a lot of old-to-young refs. + Give the minor GC a chance to run if it needs to. */ + //caml_check_urgent_gc(Val_unit); + return Val_unit; +} + + +////////////////////// BP + +extern "C" value caml_bitmap_create(value size) +{ + CAMLparam1(size); + size_t bits = Long_val(size); + size_t words = bits / (8*sizeof(unsigned int)); + unsigned int *buffer = (unsigned int*) calloc(words+1, sizeof(unsigned int)); + if (buffer == NULL) + CAMLRAISEMSG("BP: cannot allocate memory"); + CAMLreturn( (value) buffer); +} + +extern "C" value caml_bitmap_resize(value bitmap, value nsize) +{ + CAMLparam2(bitmap, nsize); + size_t bits = Long_val(nsize); + size_t bytes = (bits / (8 * sizeof(unsigned int)) + 1 ) * sizeof(unsigned int); + fprintf(stderr, "Growing to: %lu bytes\n", (bits / (8 * sizeof(unsigned int)) + 1 ) * sizeof(unsigned int)); + unsigned int * buffer = (unsigned int*) realloc((void *) bitmap, bytes); + if (buffer == NULL) + CAMLRAISEMSG("BP: cannot reallocate memory"); + CAMLreturn((value) buffer); +} + +extern "C" value caml_bitmap_setbit(value bitmap, value i, value b) +{ + CAMLparam3(bitmap, i, b); + unsigned int j = Int_val(i); + unsigned int x = Bool_val(b); + bp_setbit ((unsigned int*) bitmap, j, x); + CAMLreturn(Val_unit); +} + +extern "C" void caml_bp_delete(value b) +{ + CAMLparam1(b); + bp * B = Obj_val(b); + bp_delete(B); + CAMLreturn0; +} + +extern "C" value caml_bp_construct(value bitmap, value npar) +{ + CAMLparam2(bitmap, npar); + CAMLlocal1(res); + bp * b = bp_construct(Int_val(npar), (unsigned int *) bitmap, OPT_DEGREE); + res = sxsi_alloc_custom(caml_bp_delete); + Obj_val(res) = b; + CAMLreturn(res); +} + +extern "C" value caml_bp_first_child(value b, value idx) +{ + CAMLparam2(b, idx); + CAMLreturn (Val_int( bp_first_child(Obj_val(b), Int_val(idx)))); +} + + +extern "C" value caml_bp_next_sibling(value b, value idx) +{ + CAMLparam2(b, idx); + CAMLreturn (Val_int(bp_next_sibling(Obj_val(b), Int_val(idx)))); +} + +extern "C" value caml_bp_preorder_rank(value b, value idx) +{ + CAMLparam2(b, idx); + CAMLreturn (Val_int(bp_preorder_rank(Obj_val(b), Int_val(idx)) - 1)); +} + + +extern "C" value caml_bp_load(value file) +{ + CAMLparam1(file); + CAMLlocal1(result); + bp *B; + int f1 = Int_val(file); + int f2 = dup(f1); + FILE * fd = fdopen(f2, "r"); + if (fd == NULL) + CAMLRAISEMSG("Error opening bp file"); + B = loadTree(fd); + fclose(fd); + result = sxsi_alloc_custom(caml_bp_delete); + Obj_val(result) = B; + CAMLreturn(result); +} + +extern "C" value caml_bp_save(value b, value file) +{ + CAMLparam2(b, file); + bp *B = Obj_val(b); + int f1 = Int_val(file); + int f2 = dup(f1); + FILE * fd = fdopen(f2, "a"); + fprintf(stderr, "Writing %i %p bytes\n", ((B->n+D-1)/D)*8, B ); + fflush(stderr); + if (fd == NULL) + CAMLRAISEMSG("Error saving bp file"); + saveTree(B, fd); + fclose(fd); + CAMLreturn(Val_unit); +} +