X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FOCamlDriver.cpp;h=4a31dad386e8b507824bd290ff2fdaf31ac3d88a;hb=feae5b72d47e0ae245145d401ba73804ce18fc8c;hp=7cf70c5a57f8908e1d7dc709d9fae52cd9504e4e;hpb=f481ede5e31e02fad95d3d0659afb905ed9e03c9;p=SXSI%2Fxpathcomp.git diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index 7cf70c5..4a31dad 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -20,7 +20,6 @@ #include "XMLTree.h" #include "XMLTreeBuilder.h" -#include "Grammar.h" #include "Utils.h" #include "common_stub.hpp" @@ -32,8 +31,6 @@ #define XMLTREEBUILDER(x) (Obj_val(x)) -#define GRAMMAR(x) (Obj_val(x)) - #define TREENODEVAL(i) ((treeNode) (Int_val(i))) #define TAGVAL(i) ((TagType) (Int_val(i))) @@ -44,6 +41,7 @@ extern "C" { #include #include #include +#include } @@ -160,7 +158,7 @@ extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value s XMLTree * tree; try { - tree = XMLTree::Load(Int_val(fd),Bool_val(load_tc),Int_val(sf), String_val(name)); + 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); @@ -896,162 +894,6 @@ 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)