From: kim Date: Sun, 3 May 2009 04:11:30 +0000 (+0000) Subject: Commit before branching to new XPath compilation X-Git-Url: http://git.nguyen.vg/gitweb/?a=commitdiff_plain;h=d550133ad7afdf65c5e284c2bcf67a5bdde6faa7;p=SXSI%2Fxpathcomp.git Commit before branching to new XPath compilation git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@370 3cdefd35-fc62-479d-8e8d-bae585ffb9ca --- diff --git a/OCamlDriver.cpp b/OCamlDriver.cpp index a35cd75..e2c6f00 100644 --- a/OCamlDriver.cpp +++ b/OCamlDriver.cpp @@ -1,16 +1,23 @@ /************************************** * OCamlDriver.cpp * ------------------- - * A Test Ocaml Driver which calls the C++ methods and + * An Ocaml Driver which calls the C++ methods and * adds a C wrapper interface with OCaml code. * * Author: Kim Nguyen * Date: 04/11/08 */ -/* OCaml memory managment */ + + #include +#include +#include "XMLDocShredder.h" +#include "XMLTree.h" +#include "Utils.h" + extern "C" { +/* OCaml memory managment */ #include #include #include @@ -19,14 +26,6 @@ extern "C" { #include -} //extern C - - -//#include "TextCollection/TextCollection.h" -#include "XMLDocShredder.h" -#include "XMLTree.h" -#include "Utils.h" - #define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) )) #define NOT_IMPLEMENTED(s) (caml_failwith(s)) #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x))) @@ -34,20 +33,19 @@ extern "C" { #define TEXTCOLLECTION(x) #define TREENODEVAL(i) ((treeNode) (Int_val(i))) #define XMLTREE_ROOT 0 - - - -extern "C" { + static struct custom_operations ops; static struct custom_operations set_ops; static value * cpp_exception = NULL; static bool ops_initialized = false; - + } + extern "C" void caml_xml_tree_finalize(value tree){ delete XMLTREE(tree); return; } + extern "C" void caml_hset_finalize(value hblock){ delete HSET(hblock); return; @@ -56,7 +54,7 @@ extern "C" void caml_hset_finalize(value hblock){ extern "C" CAMLprim value caml_init_lib (value unit) { CAMLparam1(unit); if (!ops_initialized){ - + ops.identifier = (char*) "XMLTree"; ops.finalize = caml_xml_tree_finalize; @@ -64,6 +62,11 @@ extern "C" CAMLprim value caml_init_lib (value unit) { set_ops.finalize = caml_hset_finalize; cpp_exception = caml_named_value("CPlusPlusError"); + if (cpp_exception == NULL){ + string s = "FATAL: Unregistered exception "; + s += "CPlusPlusError"; + caml_failwith(s.c_str()); + }; ops_initialized = true; @@ -185,6 +188,7 @@ extern "C" CAMLprim value caml_text_collection_count(value tree,value str){ CAMLreturn (Val_unit); } +bool docId_comp(DocID x, DocID y) { return x < y; }; extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){ CAMLparam2(tree,str); @@ -193,13 +197,16 @@ extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){ std::vector results; results = XMLTREE(tree)->Contains(cstr); //free(cstr); - resarray = caml_alloc_tuple(results.size()); + std::sort(results.begin(), results.end(), docId_comp); + size_t s = results.size(); + resarray = caml_alloc_tuple(s); - for (unsigned int i=0; iParentNode((DocID) Int_val(id)))); } - extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) { CAMLparam3(tree,id1,id2); CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2)))); diff --git a/ata.ml b/ata.ml index e383e52..c3dbc47 100644 --- a/ata.ml +++ b/ata.ml @@ -160,7 +160,7 @@ struct let psize = (size f1) + (size f2) in let nsize = (size (not_ f1)) + (size (not_ f2)) in let sp,sn = merge_states f1 f2 in - fst (cons (Or(f1,f2)) (And(not_ f1,not_ f2)) sp sn psize nsize) + fst (cons (Or(f1,f2)) (And(not_ f1,not_ f2)) sp sn psize nsize) let and_ f1 f2 = @@ -255,9 +255,9 @@ let dump ppf a = if TagSet.is_finite ts then "{" ^ (TagSet.fold (fun t a -> a ^ " '" ^ (Tag.to_string t)^"'") ts "") ^" }" else let cts = TagSet.neg ts in - if TagSet.is_empty cts then "*" else - (TagSet.fold (fun t a -> a ^ " " ^ (Tag.to_string t)) cts "*\\{" - )^ "}" + if TagSet.is_empty cts then "*" else + (TagSet.fold (fun t a -> a ^ " " ^ (Tag.to_string t)) cts "*\\{" + )^ "}" in let s = Printf.sprintf "(%s,%i)" s q in let s_frm = @@ -792,22 +792,24 @@ END StateSet.print fmt k; Format.fprintf fmt "-> %i\n" (RS.length d)) c.results; Format.fprintf fmt "\n%!" - + let merge c1 c2 = - let acc1 = IMap.fold (fun s r acc -> - IMap.add s - (try - RS.concat r (IMap.find s acc) - with - | Not_found -> r) acc) c1.results IMap.empty + let acc1 = + IMap.fold + ( fun s r acc -> + IMap.add s + (try + RS.concat r (IMap.find s acc) + with + | Not_found -> r) acc) c1.results IMap.empty in let imap = - IMap.fold (fun s r acc -> - IMap.add s - (try - RS.concat r (IMap.find s acc) - with - | Not_found -> r) acc) c2.results acc1 + IMap.fold (fun s r acc -> + IMap.add s + (try + RS.concat r (IMap.find s acc) + with + | Not_found -> r) acc) c2.results acc1 in let h,s = Ptss.fold @@ -830,25 +832,25 @@ END |SList.Cons(s,sll), formlist::fll -> let r',(rb,rb1,rb2,mark) = let key = SList.hash sl,Formlist.hash formlist,dir in - try - Hashtbl.find h_fold key - with - Not_found -> let res = - if dir then eval_formlist s Ptset.Int.empty formlist - else eval_formlist Ptset.Int.empty s formlist - in (Hashtbl.add h_fold key res;res) + try + Hashtbl.find h_fold key + with + Not_found -> let res = + if dir then eval_formlist s Ptset.Int.empty formlist + else eval_formlist Ptset.Int.empty s formlist + in (Hashtbl.add h_fold key res;res) + in + if rb && ((dir&&rb1)|| ((not dir) && rb2)) + then + let acc = + let old_r = + try Configuration.IMap.find s conf.Configuration.results + with Not_found -> RS.empty in - if rb && ((dir&&rb1)|| ((not dir) && rb2)) - then - let acc = - let old_r = - try Configuration.IMap.find s conf.Configuration.results - with Not_found -> RS.empty - in - Configuration.add acc r' (if mark then RS.cons t old_r else old_r) - in - loop sll fll acc - else loop sll fll acc + Configuration.add acc r' (if mark then RS.cons t old_r else old_r) + in + loop sll fll acc + else loop sll fll acc | _ -> assert false in loop slist fl_list Configuration.empty @@ -882,24 +884,23 @@ END accu,conf,next else - let below_right = Tree.is_below_right tree t next in - - let accu,rightconf,next_of_next = - if below_right then (* jump to the next *) - bottom_up a tree next conf (jump_fun next) jump_fun (Tree.next_sibling tree t) true init accu - else accu,Configuration.empty,next - in + let below_right = Tree.is_below_right tree t next in + + let accu,rightconf,next_of_next = + if below_right then (* jump to the next *) + bottom_up a tree next conf (jump_fun next) jump_fun (Tree.next_sibling tree t) true init accu + else accu,Configuration.empty,next + in let sub = if dotd then - if below_right then prepare_topdown a tree t true - else prepare_topdown a tree t false + if below_right then prepare_topdown a tree t true + else prepare_topdown a tree t false else conf in let conf,next = (Configuration.merge rightconf sub, next_of_next) in - if t == root then accu,conf,next - else + if t == root then accu,conf,next else let parent = Tree.binary_parent tree t in let ptag = Tree.tag tree parent in let dir = Tree.is_left tree t in @@ -915,7 +916,7 @@ END in bottom_up a tree parent newconf next jump_fun root false init accu - + and prepare_topdown a tree t noright = let tag = Tree.tag tree t in (* pr "Going top down on tree with tag %s = %s "