-IXMLTree/libcds/includes \
-IXMLTree/TextCollection
-CXXFLAGS = -O3 -Wall $(INCLUDEDIRS) -fPIC
+CXXFLAGS = -O3 -Wall $(INCLUDEDIRS) -fPIC -std=c++0x
ifeq ($(VERBOSE),true)
HIDE=
else
SYNT_DEBUG = -ppopt -DDEBUG
else
CXX = g++
-OCAMLOPT = ocamlopt -cc "$(CXX)" -ccopt -O3 -noassert -inline 100
+OCAMLOPT = ocamlopt -cc "$(CXX)" -ccopt -O3 -ccopt -std=c++0x -noassert -inline 1000
endif
ifeq ($(PROFILE), true)
SYNT_PROF = $(SYNT_DEBUG) -ppopt -DPROFILE
extern "C" CAMLprim value caml_text_collection_get_cached_text(value tree, value id){
CAMLparam2(tree,id);
CAMLlocal1(str);
- const char* txt = (const char*) XMLTREE(tree)->GetCachedText((DocID) Int_val(id));
+ char* txt = (char*) XMLTREE(tree)->GetCachedText((DocID) Int_val(id));
str = caml_copy_string(txt);
+ free(txt);
CAMLreturn (str);
}
+extern "C" CAMLprim value caml_text_collection_size(value tree){
+ CAMLparam1(tree);
+ // CAMLreturn (Val_int( XMLTREE(tree)->CachedText.size()));
+ NOT_IMPLEMENTED("text_collection_size");
+ CAMLreturn (Val_unit);
+}
+
+
extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
CAMLparam2(tree,id);
uchar * cstr = (uchar *) String_val(str);
CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
+}
+extern "C" CAMLprim value caml_text_collection_count(value tree,value str){
+ CAMLparam2(tree,str);
+ //uchar * cstr = (uchar *) String_val(str);
+ NOT_IMPLEMENTED("text_collection_count");
+ CAMLreturn (Val_unit);
+
}
extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
void SXSIStorageInterface::nodeFinished(string name)
{
tree->NewClosingTag((unsigned char*) name.c_str());
- }
+
+}
void SXSIStorageInterface::parsingFinished()
{
INCLUDE "debug.ml"
module Tree = Tree.Binary
+
let gen_id =
let id = ref (-1) in
fun () -> incr id;!id
| Concat(t1,t2) -> aux acc t1 (Concat(t2,rest))
in
aux [] t.node Nil
+
let length = function { size = s } -> s
let iter f { node = n } =
in loop n
end
-
+ module TS2 =
+ struct
+ type t = string
+ let empty = String.make 10_000_000 '0'
+ let cons e t = t.[Tree.id e] <- '1';t
+ let append = cons
+ let concat s1 s2 = failwith "not implemented"
+
+ let length t =
+ let res = ref 0 in
+ for i = 0 to 9_999_999 do
+ if t.[i] == '1' then
+ incr res
+ done; !res
+
+ let iter f t = failwith "not implemented"
+ let to_list_rev t = failwith "not implemented"
+ end
module BottomUpNew = struct
let hfeval = HFEval.create 4097
+(* let miss = ref 0
+ let call = ref 0
+ let timeref = ref 0.0
+ let timerefall = ref 0.0
+ let time f x =
+ incr call;
+ let t1 = Unix.gettimeofday ()
+ in let r = f x
+ in
+ timeref := !timeref +. ((Unix.gettimeofday()) -. t1);
+ r
+
+ let timeall f x =
+ let t1 = Unix.gettimeofday ()
+ in let r = f x
+ in
+ timerefall := !timerefall +. ((Unix.gettimeofday()) -. t1);
+ r
+
+*)
+
+
let eval_form_bool f s1 s2 =
let rec eval f = match f.pos with
| Atom(`Left,b,q) -> if b == (Ptset.mem q s1) then (true,true,false) else false,false,false
| False -> false,false,false
| _ ->
try
- HFEval.find hfeval (f.fid,s1,s2)
+ HFEval.find hfeval (f.fid,s1,s2)
with
| Not_found -> let r =
match f.pos with
else (accf,accm,acchtrue)
) acc (Hashtbl.find a.phi q)
- let miss = ref 0
- let call = ref 0
- let get_trans t a tag r =
+
+ let get_trans t a tag r =
try
let mark,f,predl,has_true =
HTagSet.find a.sigma (r,tag)
- in f.st,f,mark,has_true,r,predl
+ in f.st,f,mark,has_true,r
with
- Not_found ->
+ Not_found ->
let f,mark,has_true,accq =
Ptset.fold (fun q (accf,accm,acchtrue,accq) ->
let naccf,naccm,nacctrue =
r (false_,false,false,Ptset.empty)
in
HTagSet.add a.sigma (accq,tag) (mark,f,([],[]),has_true);
- f.st,f,mark,has_true,accq,([],[])
+ f.st,f,mark,has_true,accq
let check_pred l t = true (*l = [] ||
*)
- let rec accepting_among2 a t r acc =
+ let rec accepting_among2 a t r acc =
let orig = r in
let rest = Ptset.inter r a.final in
let r = Ptset.diff r rest in
then
orig,acc
else
- let tag = Tree.tag t in
let t1 = Tree.first_child t
and t2 = Tree.next_sibling t in
- let (r1,r2),formula,mark,has_true,r,_ = get_trans t a tag r
+ let (r1,r2),formula,mark,has_true,r = get_trans t a (Tree.tag t) r
in
let s1,res1 = accepting_among2 a t1 r1 acc
in
else
orig,(if mark then TS.append t (res2)
else res2)
-
+
+
+ let rec accepting_among a t r =
+ let orig = r in
+ let rest = Ptset.inter r a.final in
+ let r = Ptset.diff r rest in
+ if Ptset.is_empty r then rest,TS.empty else
+ if Tree.is_node t
+ then
+ let (r1,r2),formula,mark,has_true,r = get_trans t a (Tree.tag t) r
+ in
+ let s1,res1 = accepting_among a (Tree.first_child t) r1
+ and s2,res2 = accepting_among a (Tree.next_sibling t) r2
+ in
+ let rb,rb1,rb2 = eval_form_bool formula s1 s2 in
+ if rb
+ then
+ let res1 = if rb1 then res1 else TS.empty
+ and res2 = if rb2 then res2 else TS.empty
+ in r, TS.concat res2 (if mark then TS.cons t res1 else res1)
+ else orig,TS.empty
+ else orig,TS.empty
+
+
+
+
+ let rec accepting_count a t r =
+ let orig = r in
+ let rest = Ptset.inter r a.final in
+ let r = Ptset.diff r rest in
+ if Ptset.is_empty r then rest,0 else
+ if Tree.is_node t
+ then
+ let (r1,r2),formula,mark,has_true,r = get_trans t a (Tree.tag t) r
+ in
+ let s1,res1 = accepting_count a (Tree.first_child t) r1
+ and s2,res2 = accepting_count a (Tree.next_sibling t) r2
+ in
+ let rb,rb1,rb2 = eval_form_bool formula s1 s2 in
+ if rb
+ then
+ let res1 = if rb1 then res1 else 0
+ and res2 = if rb2 then res2 else 0
+ in r, res1+res2+(if mark then 1 else 0)
+ else orig,0
+ else orig,0
+
let run a t =
- let st,res = accepting_among2 a t a.init TS.empty in
+(* let _ =
+ call := 0; miss:=0;
+ timeref := 0.0;
+ HFEval.clear hfeval;
+ Hashtbl.clear dnf_hash;
+ Hashtbl.clear fstate_pool;
+ in *)
+ let st,res = accepting_among a t a.init in
let b = Ptset.is_empty (st) in
if b then TS.empty
else
res
+
+ let run_count a t =
+(* let _ =
+ call := 0; miss:=0;
+ timeref := 0.0;
+ timerefall := 0.0;
+ HFEval.clear hfeval;
+ Hashtbl.clear dnf_hash;
+ Hashtbl.clear fstate_pool;
+ in *)
+ let st,res = accepting_count a t a.init in
+ let b = Ptset.is_empty (st) in
+ if b then 0
+ else
+ res
+ end
+
+ module Jump = struct
+ let eval_dir = BottomUpNew.eval_dir
+ let xi1 = HTagSet.create 10
+ let xi2 = HTagSet.create 10
+
+
+ let rec accept_from orig a t r acc =
+ if (Tree.is_root t) ||
+ (Ptset.subset orig r)
+ then
+ acc
+ else
+ let is_left = Tree.is_left t in
+ let tag = Tree.tag t in
+ let nr,f, mark =
+ try
+ HTagSet.find (if is_left then xi1 else xi2)
+ (r,tag)
+ with
+ | Not_found ->
+ let trans =
+ Hashtbl.fold
+ (fun q l acc ->
+ List.fold_left (fun ((racc,facc,macc) as acc) (ts,(m,f,_)) ->
+ let rl,rr = f.st in
+ if (TagSet.mem tag ts) &&
+ (Ptset.intersect (if is_left then rl else rr) r)
+ then (Ptset.add q racc,or_ f facc, macc||m)
+ else acc) acc l)
+ a.phi (Ptset.empty,false_,false)
+
+ in
+ HTagSet.add (if is_left then xi1 else xi2) (r,tag) trans;
+ trans
+ in
+ let form = eval_dir (if is_left then `Left else `Right) f r
+ in
+ if is_true form then accept_from orig a (Tree.parent t) nr
+ (if mark then TS.cons t acc else acc)
+ else if is_false form then TS.empty
+ else assert false
+
+ let run a t r =
+ HTagSet.clear xi1;
+ HTagSet.clear xi2;
+ let orig =
+ List.fold_left (fun s (_,(_,f,_)) ->
+ Ptset.union s (fst f.st))
+ Ptset.empty (Hashtbl.find a.phi (Ptset.choose a.init))
+ in
+ accept_from orig a t r TS.empty
+
+
end
-(* module Ptset : sig
+(* module Ptset : sig
include Set.S with type elt = int
val from_list : elt list -> t
end
-*)
+ *)
type state = int
val mk_state : unit -> state
module BottomUpNew :
sig
val run : t -> Tree.Binary.t -> TS.t
+ val run_count : t -> Tree.Binary.t -> int
+end
+
+module Jump :
+sig
+ val run : t -> Tree.Binary.t -> Ptset.t -> TS.t
end
+++ /dev/null
-(******************************************************************************)
-(* SXSI : XPath evaluator *)
-(* Kim Nguyen (Kim.Nguyen@nicta.com.au) *)
-(* Copyright NICTA 2008 *)
-(* Distributed under the terms of the LGPL (see LICENCE) *)
-(******************************************************************************)
-INCLUDE "debug.ml";;
-
-module State =
-struct
- type t = int
- let mk = let i = ref ~-1 in fun () -> incr i;!i
- let compare p q = p - q
- let equal p q = p==q
- let hash p = p
- let print fmt p = Format.fprintf fmt "<%.6i>" p
-end
-
-module ISet : Set.S with type elt = int=
-struct
- let max = Sys.word_size - 2
- type t = int
- type elt = int
-
- let empty = 0
- let full = -1
- let is_empty x = x == 0
- let mem e s = ((1 lsl e) land s) != 0
- let add e s = (1 lsl e) lor s
- let singleton e = (1 lsl e)
- let union a b = a lor b
- let inter a b = a land b
- let diff a b = a land (lnot b)
- let remove e s = (lnot (1 lsl e) land s)
- let compare = (-)
- let equal = (==)
- let subset a b = a land (lnot b) == 0
- let cardinal s =
- let rec loop n s =
- if s == 0 then n else loop (succ n) (s - (s land (-s)))
- in
- loop 0 s
-(* inverse of bit i = 1 lsl i i.e. tib i = log_2(i) *)
-let log2 = Array.create 255 0
-let () = for i = 0 to 7 do log2.(1 lsl i) <- i done
-
-(* assumption: x is a power of 2 *)
-let tib32 x =
- if x land 0xFFFF == 0 then
- let x = x lsr 16 in
- if x land 0xFF == 0 then 24 + log2.(x lsr 8) else 16 + log2.(x)
- else
- if x land 0xFF == 0 then 8 + log2.(x lsr 8) else log2.(x)
-
-let ffffffff = (0xffff lsl 16) lor 0xffff
-let tib64 x =
- if x land ffffffff == 0 then 32 + tib32 (x lsr 32) else tib32 x
-
-let tib =
- match Sys.word_size with 32 -> tib32 | 64 -> tib64 | _ -> assert false
-
-let min_elt s =
- if s == 0 then raise Not_found;
- tib (s land (-s))
-
-let choose = min_elt
-
-(* TODO: improve? *)
-let max_elt s =
- if s == 0 then raise Not_found;
- let rec loop i =
- if s land i != 0 then tib i
- else if i = 1 then raise Not_found else loop (i lsr 1)
- in
- loop min_int
-
-let rec elements s =
- if s == 0 then [] else let i = s land (-s) in tib i :: elements (s - i)
-
-let rec iter f s =
- if s != 0 then let i = s land (-s) in f (tib i); iter f (s - i)
-
-let rec fold f s acc =
- if s == 0 then acc else let i = s land (-s) in fold f (s - i) (f (tib i) acc)
-
-let rec for_all p s =
- s == 0 || let i = s land (-s) in p (tib i) && for_all p (s - i)
-
-let rec exists p s =
- s != 0 && let i = s land (-s) in p (tib i) || exists p (s - i)
-
-let rec filter p s =
- if s == 0 then
- 0
- else
- let i = s land (-s) in
- let s = filter p (s - i) in
- if p (tib i) then s + i else s
-
-let rec partition p s =
- if s == 0 then
- 0, 0
- else
- let i = s land (-s) in
- let st,sf = partition p (s - i) in
- if p (tib i) then st + i, sf else st, sf + i
-
-let split i s =
- let bi = 1 lsl i in
- s land (bi - 1), s land bi != 0, s land (-1 lsl (i+1))
-
-
-end
-(* module SSet = Set.Make(State)*)
-module SSet = ISet
-
-module Transition =
-struct
-
- type t = Label of State.t * TagSet.Xml.t * State.t * State.t
- | External of State.t * (Tree.Binary.t -> bool)*State.t * State.t
-
- let source = function Label(s,_,_,_) | External(s,_,_,_) -> s
- let dest1 = function Label(_,_,d,_) | External(_,_,d,_) -> d
- let dest2 = function Label(_,_,_,d) | External(_,_,_,d) -> d
-
- let compatible t1 t2 =
- State.equal (source t1) (source t2)
- && State.equal (dest1 t1) (dest1 t2)
- && State.equal (dest2 t1) (dest2 t2)
-
- let check t1 t2 =
- if not (compatible t1 t2)
- then failwith "Incompatible transitions"
-
- let cup t1 t2 =
- check t1 t2;
- match (t1,t2) with
- | Label(s,ts,d1,d2), Label(_,ts',_,_) -> Label(s,TagSet.Xml.cup ts ts',d1,d2)
- | External(s,f,d1,d2), External(_,f',_,_) -> External(s,(fun x -> (f x)||(f' x)),d1,d2)
- | Label(s,ts,d1,d2), External(_,f,_,_)
- | External(_,f,_,_), Label(s,ts,d1,d2) -> External(s,(fun x -> (TagSet.Xml.mem (Tree.Binary.tag x) ts)||f x),d1,d2)
-
- let cap t1 t2 =
- check t1 t2;
- match (t1,t2) with
- | Label(s,ts,d1,d2), Label(_,ts',_,_) -> Label(s,TagSet.Xml.cap ts ts',d1,d2)
- | External(s,f,d1,d2), External(_,f',_,_) -> External(s,(fun x -> (f x)&&(f' x)),d1,d2)
- | Label(s,ts,d1,d2), External(_,f,_,_)
- | External(_,f,_,_), Label(s,ts,d1,d2) -> External(s,(fun x -> (TagSet.Xml.mem (Tree.Binary.tag x) ts)&& f x),d1,d2)
-
- let neg = function
- | Label(s,ts,d1,d2) -> Label(s,TagSet.Xml.neg ts,d1,d2)
- | External(s,f,d1,d2) -> External(s,(fun x -> not(f x)), d1 ,d2)
-
-
- let can_take t = function
- | Label(_,ts,_,_) -> TagSet.Xml.mem (Tree.Binary.tag t) ts
- | External(_,f,_,_) -> f t
-
- (* Hashtbl indexed by source State *)
- module HT = Hashtbl.Make(State)
-
-
-
- type hashtbl = { label : (TagSet.Xml.t*State.t*State.t) HT.t;
- extern : ((Tree.Binary.t-> bool)*State.t*State.t) HT.t;
- }
-
-
- let empty () = { label = HT.create 17;
- extern = HT.create 17;
- }
-
- let clear h = HT.clear h.label; HT.clear h.extern
-
- let add h = function
- | Label(s,t,d1,d2) -> HT.add h.label s (t,d1,d2)
- | External(s,f,d1,d2) -> HT.add h.extern s (f,d1,d2)
-
- let find_all ?(accu=[]) ?(pred_label=fun _ _ _ _ -> true) ?(pred_extern= fun _ _ _ _ -> true) h q =
- List.fold_left
- (fun acc (t,d1,d2) ->
- if pred_label q t d1 d2
- then Label(q,t,d1,d2) :: acc
- else acc)
- (List.fold_left
- (fun acc (f,d1,d2) ->
- if pred_extern q f d1 d2
- then External(q,f,d1,d2) :: acc
- else acc)
- accu
- (HT.find_all h.extern q))
- (HT.find_all h.label q)
-
- let find_all_dest q h =
- HT.fold (fun source (t,q1,q2) acc ->
- if (State.equal q1 q || State.equal q2 q)
- then Label(source,t,q1,q2)::acc
- else acc) h.label
- (HT.fold (fun source (t,q1,q2) acc ->
- if (State.equal q1 q || State.equal q2 q)
- then External(source,t,q1,q2)::acc
- else acc) h.extern [])
-
-
- let fold_state f_lab f_ext h q acc =
- List.fold_left
- (fun acc (t,d1,d2) ->
- f_lab acc q t d1 d2)
- (List.fold_left
- (fun acc (f,d1,d2) ->
- f_ext acc q f d1 d2)
- acc
- (HT.find_all h.extern q))
- (HT.find_all h.label q)
-
-
-end
-module BST = Set.Make(Tree.Binary)
-
-type t = { initial : SSet.t;
- final : SSet.t;
- transitions : Transition.hashtbl;
- marking : SSet.t;
- ignore : SSet.t;
- mutable result : BST.t;
- (* Statistics *)
- mutable numbt : int;
- mutable max_states : int;
- contains : (string,Tree.Binary.DocIdSet.t) Hashtbl.t;
- }
-
-let mk () = { initial = SSet.empty;
- final = SSet.empty;
- transitions = Transition.empty();
- marking = SSet.empty;
- ignore = SSet.empty;
- result = BST.empty;
- numbt = 0;
- max_states = 0;
- contains = Hashtbl.create 37;
-
- };;
-
- let print_tags fmt l =
- let l =
- if TagSet.Xml.is_finite l then l
- else (Format.fprintf fmt "* \\ "; TagSet.Xml.neg l )
- in
- Format.fprintf fmt "{ ";
- ignore(TagSet.Xml.fold (fun t first ->
- if not first
- then Format.fprintf fmt " ,";
- Tag.print fmt t; false) l true);
- Format.fprintf fmt "}"
-
- let dump fmt auto =
- Format.fprintf fmt "----------------- Automaton dump -------------------\n";
- Format.fprintf fmt "Initial states: ";
- SSet.iter (fun s -> State.print fmt s;
- Format.fprintf fmt " ") auto.initial;
- Format.fprintf fmt "\n";
- Format.fprintf fmt "Final states: ";
- SSet.iter (fun s -> State.print fmt s;
- Format.fprintf fmt " ") auto.final;
- Format.fprintf fmt "\n";
- Format.fprintf fmt "Marking states: ";
- SSet.iter (fun s -> State.print fmt s;
- Format.fprintf fmt " ") auto.marking;
- Format.fprintf fmt "\n";
- Format.fprintf fmt "Ignore states: ";
- SSet.iter (fun s -> State.print fmt s;
- Format.fprintf fmt " ") auto.ignore;
- Format.fprintf fmt "\n";
- Format.fprintf fmt "Transitions:\n";
- Transition.HT.iter (fun source (l,dest1,dest2) ->
- State.print fmt source;
- Format.fprintf fmt "-> ";
- print_tags fmt l;
- Format.fprintf fmt "(";
- State.print fmt dest1;
- Format.fprintf fmt " ,";
- State.print fmt dest2;
- Format.fprintf fmt ")\n") auto.transitions.Transition.label;
- Format.fprintf fmt "----------------------------------------------------\n"
-
-
-
-module BottomUp =
-struct
-
- exception Fail
-
- let pr_states fmt st = SSet.iter (fun s -> State.print fmt s;
- Format.fprintf fmt " ") st
-
- let err = Format.err_formatter
- let filter_map_rev filt map l =
- let rec loop ((accuf,accum) as accu) = function
- | [] -> accu
- | t::r -> loop (if filt t then (t::accuf,SSet.add (map t) accum)
- else accu) r
- in
- loop ([],SSet.empty) l
-
- let mem s x = SSet.mem x s
-
-
- let rec accepting_among ?(nobrother=false) ?(strings=None) auto t r =
- if SSet.is_empty r then r else
- match strings with
- | Some valid_strings when Tree.Binary.DocIdSet.for_all (fun i -> not(Tree.Binary.string_below t i)
- ) valid_strings
- -> SSet.empty
- | _ -> (
-
- let to_ignore = SSet.inter auto.ignore r in
- let r = SSet.diff r to_ignore
- in
- let res =
- match Tree.Binary.descr t with
- | Tree.Binary.Nil -> SSet.inter r auto.final
- | Tree.Binary.String id -> (
- match strings with
- | None -> SSet.inter r auto.final
- | Some valid_strings when (Tree.Binary.DocIdSet.mem id valid_strings)
- -> Printf.eprintf "Selecting string '%s'\n%!" (Tree.Binary.get_string t id);
- SSet.inter r auto.final
- | _ -> SSet.empty
- )
- | Tree.Binary.Node(_) ->
- let t1 = Tree.Binary.left t
- and t2 = Tree.Binary.right t
- in
- let transitions =
- SSet.fold
- ( fun q accu ->
- Transition.fold_state
- (fun acc q t d1 d2 -> Transition.Label(q,t,d1,d2) :: acc)
- (fun acc q t d1 d2 -> Transition.External(q,t,d1,d2) :: acc)
- auto.transitions q accu) r []
- in
- let transitions,r1 =
- filter_map_rev
- (Transition.can_take t)
- Transition.dest1 transitions
- in
- let s1 = accepting_among auto t1 r1
- in
- let transitions,r2 =
- filter_map_rev
- (fun x->SSet.mem (Transition.dest1 x) s1)
- Transition.dest2 transitions
- in
- let s2 = if nobrother then SSet.union (SSet.inter r auto.final) to_ignore
- else accepting_among auto t2 r2
- in
- let _,s = filter_map_rev
- (fun x -> SSet.mem (Transition.dest2 x) s2)
- (Transition.source) transitions
- in
- if SSet.is_empty s then s
- else
- (if SSet.exists (mem auto.marking) s1 || SSet.exists (mem auto.marking) s2
- then auto.result <- BST.add t auto.result;s)
- in SSet.union to_ignore res)
-
-
- let accept ?(strings=None) auto t =
- auto.result <- BST.empty;
- if SSet.is_empty (accepting_among ~nobrother:true ~strings:strings auto t auto.initial)
- then false
- else true
-end
-
-module TopDown = struct
- let rec accept_at auto t q =
- if SSet.mem q auto.ignore then true
- else
- match Tree.Binary.descr t with
- | Tree.Binary.Nil | Tree.Binary.String _ -> SSet.mem q auto.final
- | Tree.Binary.Node(_) ->
- let tag = Tree.Binary.tag t
- and t1 = Tree.Binary.left t
- and t2 = Tree.Binary.right t
- in
- let transitions =
- Transition.find_all
- ~pred_label:(fun _ ts _ _ -> TagSet.Xml.mem tag ts)
- ~pred_extern:(fun _ f _ _ -> f t)
- auto.transitions q
- in
- let rec iter_trans res = function
- [] -> res
- | (Transition.Label(_,_,q1,q2) | Transition.External (_,_,q1,q2))::r ->
- let _ = auto.numbt <- succ auto.numbt in
- if (accept_at auto t1 q1) && (accept_at auto t2 q2)
- then
- begin
- if (SSet.mem q1 auto.marking)||(SSet.mem q2 auto.marking)
- then
- begin
- auto.result <- BST.add t auto.result;
- end;
- iter_trans true r
- end
- else
- iter_trans res r
- in iter_trans false transitions
-
-
-
-
- let accept auto t =
- auto.numbt <- -1;
- SSet.exists (fun q ->
- P(auto.numbt <- succ auto.numbt);
- auto.result <- BST.empty;
- accept_at auto t q) auto.initial
-
-
- let rec run_in auto t states =
- if SSet.is_empty states then ()
- else
- match Tree.Binary.descr t with
- | Tree.Binary.Nil | Tree.Binary.String _ -> ()
- | Tree.Binary.Node(_) ->
- let tag = Tree.Binary.tag t
- and t1 = Tree.Binary.left t
- and t2 = Tree.Binary.right t
- in
- P(let i = SSet.cardinal states in
- if i > auto.max_states then auto.max_states <- i);
- let s1,s2 =
- SSet.fold
- (fun q acc ->
- if SSet.mem q auto.ignore then acc
- else
- Transition.fold_state
- (fun (ss1,ss2) _ ts d1 d2 ->
- if TagSet.Xml.mem tag ts
- then
- (SSet.add d1 ss1,
- SSet.add d2 ss2)
- else (ss1,ss2))
- (fun (ss1,ss2) _ f d1 d2 ->
- if f t
- then
- (SSet.add d1 ss1,
- SSet.add d2 ss2)
- else (ss1,ss2)) auto.transitions q acc ) states (SSet.empty,SSet.empty)
- in
- if SSet.is_empty (SSet.inter auto.marking (SSet.union s1 s2))
- then ()
- else auto.result <- BST.add t auto.result;
- run_in auto t1 s1;
- run_in auto t2 s2
-
-
- let run auto t =
- auto.result <- BST.empty;
- P(auto.numbt <- 0);
-
- run_in auto t auto.initial
-
-end
-
+++ /dev/null
-(******************************************************************************)
-(* SXSI : XPath evaluator *)
-(* Kim Nguyen (Kim.Nguyen@nicta.com.au) *)
-(* Copyright NICTA 2008 *)
-(* Distributed under the terms of the LGPL (see LICENCE) *)
-(******************************************************************************)
-module State :
- sig
- type t = int
- val mk : unit -> int
- val compare : int -> int -> int
- val equal : 'a -> 'a -> bool
- val hash : 'a -> 'a
- val print : Format.formatter -> int -> unit
- end
-module SSet : Set.S with type elt = State.t
-module Transition :
- sig
- type t =
- Label of State.t * TagSet.Xml.t * State.t * State.t
- | External of State.t * (Tree.Binary.t -> bool) * State.t * State.t
- val source : t -> State.t
- val dest1 : t -> State.t
- val dest2 : t -> State.t
- val cup : t -> t -> t
- val cap : t -> t -> t
- val neg : t -> t
- module HT : Hashtbl.S with type key = State.t
- type hashtbl = {
- label : (TagSet.Xml.t * State.t * State.t) HT.t;
- extern : ((Tree.Binary.t -> bool) * State.t * State.t) HT.t;
- }
- val empty : unit -> hashtbl
- val clear : hashtbl -> unit
- val add : hashtbl -> t -> unit
- val find_all :
- ?accu:t list ->
- ?pred_label:(State.t -> TagSet.Xml.t -> State.t -> State.t -> bool) ->
- ?pred_extern:(State.t ->
- (Tree.Binary.t -> bool) -> State.t -> State.t -> bool) ->
- hashtbl -> State.t -> t list
- val find_all_dest : State.t -> hashtbl -> t list
- val fold_state :
- ('a -> HT.key -> TagSet.Xml.t -> State.t -> State.t -> 'a) ->
- ('a -> HT.key -> (Tree.Binary.t -> bool) -> State.t -> State.t -> 'a) ->
- hashtbl -> HT.key -> 'a -> 'a
- end
-module BST : Set.S with type elt = Tree.Binary.t
-type t = { initial : SSet.t;
- final : SSet.t;
- transitions : Transition.hashtbl;
- marking : SSet.t;
- ignore : SSet.t;
- mutable result : BST.t;
- mutable numbt : int;
- mutable max_states : int;
- contains : (string,Tree.Binary.DocIdSet.t) Hashtbl.t;
- }
-val mk : unit -> t
-val dump : Format.formatter -> t -> unit
-module BottomUp :
- sig
-
- val accepting_among : ?nobrother:bool -> ?strings:Tree.Binary.DocIdSet.t option ->
- t -> Tree.Binary.t -> SSet.t -> SSet.t
- val accept : ?strings:Tree.Binary.DocIdSet.t option ->
- t -> Tree.Binary.t -> bool
- end
-
-module TopDown :
-sig
- val accept : t -> Tree.Binary.t -> bool
- val run : t -> Tree.Binary.t -> unit
-end
let total_time () = List.fold_left (+.) 0. !l;;
+
let test_slashslash tree k =
let test =
match k with "*" -> TagSet.remove (Tag.tag "") TagSet.star
if Tree.Binary.is_node tree
then
let acc = TS.cons tree acc in
- loop acc (Tree.Binary.tagged_next tree ttag)
+ loop acc (Tree.Binary.tagged_foll tree ttag)
else
acc
let l = Tree.Binary.first_child t
and r = Tree.Binary.next_sibling t
in
- let _ = Printf.eprintf "Tree with id %i and tag=%s, tagged_desc %s is %i tagged_foll is %i, tagged_next is %i\n%!"
+ let _ = Printf.eprintf "Tree with id %i and tag=%s, tagged_desc %s is %i tagged_foll is %i\n%!"
(Tree.Binary.id t) (Tag.to_string tag) (k)
(iid (Tree.Binary.tagged_desc t ttag))
(iid (Tree.Binary.tagged_foll t ttag))
- (iid (Tree.Binary.tagged_next t ttag))
in
aux l;
aux r;
()
in
aux tree
+
+
let test_count_subtree tree k =
let ttag = Tag.tag k in
let r = time(Tree.Binary.subtree_tags tree) ttag in
Printf.eprintf "%i nodes \n%!" r
+
+let test_contains tree s =
+ let _ = Printf.eprintf "Fetching DocIds containing %s ... %!" s in
+ time (fun s -> let r = Tree.Binary.contains tree s in
+ Tree.Binary.DocIdSet.iter
+ (fun t -> output_string stderr
+ (Tree.Binary.get_string tree t);
+ output_char stderr '\n') r ) s
+
+
+let test_count_contains tree s =
+ let _ = Printf.eprintf "Counting DocIds containing %s ... %!" s in
+ let r = time (Tree.Binary.count_contains tree) s in
+ Printf.eprintf "%i documents ids\n%!" (r)
+
+let test_contains_old tree s =
+ let _ = Printf.eprintf "Fetching (old) DocIds containing %s ... %!" s in
+ let r = time (Tree.Binary.contains_old tree) s in
+ Printf.eprintf "%i documents ids\n%!" (Tree.Binary.DocIdSet.cardinal r)
+
+let test_contains_iter tree s =
+ let _ = Printf.eprintf "Fetching (old) DocIds containing %s ... %!" s in
+ let r = time (Tree.Binary.contains_iter tree) s in
+ Printf.eprintf "%i documents ids\n%!" (Tree.Binary.DocIdSet.cardinal r)
+
+module Stack =
+struct
+ type t = { mutable table: Tree.Binary.t array;
+ mutable top : int }
+
+ let empty = { table = Array.make 0 (Obj.magic 0);
+ top = 0 }
+ let cons e s =
+ let ls = Array.length s.table in
+ if ls > s.top
+ then
+ begin
+ s.table.(s.top) <- e;
+ s.top <- s.top + 1;
+ s
+ end
+ else
+
+ let a = Array.make (ls * 2 + 1) (Tree.Binary.root e)
+ in
+ Array.blit s.table 0 a 0 ls;
+ s.table <- a;
+ s.table.(s.top) <- e;
+ s.top <- s.top + 1;
+ s
+
+end
+
+let test_fast tree =
+ let rec aux t acc =
+ if Tree.Binary.is_node t
+ then
+ aux (Tree.Binary.right t)( aux (Tree.Binary.left t) (Stack.cons t acc))
+ else acc
+ in let _ = Printf.eprintf "Fast traversal ...%!" in
+ time (aux tree) Stack.empty
+
+let test_cps tree =
+ let rec aux t acc cont =
+ if Tree.Binary.is_node t
+ then aux (Tree.Binary.left t) (Stack.cons t acc) ((Tree.Binary.right t)::cont)
+ else match cont with
+ | [] -> acc
+ | p::r -> aux p acc r
+ in
+ let _ = Printf.eprintf "CPS traversal ...%!" in
+ time (aux tree Stack.empty) []
+
+
let main v query output =
let _ = Tag.init (Tree.Binary.tag_pool v) in
Printf.eprintf "Parsing query : ";
XPath.Ast.print Format.err_formatter query;
Format.fprintf Format.err_formatter "\n%!";
Printf.eprintf "Compiling query : ";
- let auto = time XPath.Compile.compile query in
-
- let _ = Ata.dump Format.err_formatter auto ;
- Format.fprintf Format.err_formatter "\n%!"
- in
- let _ = test_count_subtree v "keyword" in
- let _ = test_jump v "keyword" in
-
- Printf.eprintf "Execution time : ";
- let result = time (BottomUpNew.run auto) v in
- Printf.eprintf "Number of nodes in the result set : %i\n" (TS.length result);
- begin
- match output with
- | None -> ()
- | Some f ->
-
- Printf.eprintf "Serializing results : ";
- time( fun () ->
- let oc = open_out f in
- output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
- TS.iter (fun t -> Tree.Binary.print_xml_fast oc t;
+ let auto,_ = time XPath.Compile.compile query in
+ Printf.eprintf "Execution time %s : " (if !Options.count_only then "(counting only)" else "");
+ begin
+ if !Options.count_only then
+ let result = time (BottomUpNew.run_count auto) v
+ in
+ Printf.eprintf "Number of nodes in the result set : %i\n" result
+ else
+ let result = time (BottomUpNew.run auto) v in
+ Printf.eprintf "Number of nodes in the result set : %i\n" (TS.length result);
+ begin
+ match output with
+ | None -> ()
+ | Some f ->
+ Printf.eprintf "Serializing results : ";
+ time( fun () ->
+ let oc = open_out f in
+ output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
+ TS.iter (fun t -> output_string oc "----------\n";
+ Tree.Binary.print_xml_fast oc t;
output_char oc '\n') result) ();
- end;
- (* let _ = Ata.dump Format.err_formatter auto in
- Format.fprintf Format.err_formatter "\n%!"; *)
- Printf.eprintf "Total time : %fms\n%!" (total_time())
+ end;
+ end;
+ Printf.eprintf "Total running time : %fms\n%!" (total_time())
;;
-
Options.parse_cmdline();;
let v =
let input_file = ref ""
let output_file = ref None
let save_file = ref ""
+let count_only = ref false
+
let usage_msg = Printf.sprintf "%s <input.{xml|srx}> 'query' [output]" Sys.argv.(0)
| 2 -> output_file := Some s; incr pos
| _ -> raise (Arg.Bad(s))
-let spec = [ "-f", Arg.Set_int(sample_factor),"sample factor [default=64]";
- "-i", Arg.Set(index_empty_texts),"index empty texts [default=false]";
- "-d", Arg.Set(disable_text_collection),"Disable text collection[default=false]";
- "-s", Arg.Set_string(save_file),"Save the intermediate representation into file.srx";
- ]
+let spec = [ "-c", Arg.Set(count_only), "counting only (don't materialize the result set";
+ "-f", Arg.Set_int(sample_factor), "sample factor [default=64]";
+ "-i", Arg.Set(index_empty_texts), "index empty texts [default=false]";
+ "-d", Arg.Set(disable_text_collection), "disable text collection[default=false]";
+ "-s", Arg.Set_string(save_file), "save the intermediate representation into file.srx";
+ ]
let parse_cmdline() =
let _ = Arg.parse spec anon_fun usage_msg
val index_empty_texts : bool ref
val sample_factor : int ref
val disable_text_collection : bool ref
+val count_only : bool ref
val query : string ref
val input_file : string ref
val output_file : string option ref
let _ = WH.add pool empty
-let is_empty = function { id = 0 } -> true | _ -> false
+let is_empty s = s.id==0
let rec norm n =
let v = { id = gen_uid ();
+++ /dev/null
-#!/bin/sh
-
-echo Result for query "$1"
-cat xpath-pt/xpath/"$1".xpl
-echo
-echo
-cat results/"$1".saxon
-echo
-echo --------------------------------------------------------
-echo
-cat results/"$1".sxsi
<?xml version="1.0"?>
-<a>
- <b/>
- adadadad
- <b/>
- <c >
- <g>
- <b/>
- </g>
- </c>
- <b>
- <b/>
- </b>
-</a>
-
+<a>foo<b/><b/><c><d/></c><b/></a>
+++ /dev/null
-/site/closed_auctions/closed_auction/annotation/description/text/keyword
\ No newline at end of file
+++ /dev/null
-//closed_auction//keyword
\ No newline at end of file
+++ /dev/null
-/site/closed_auctions/closed_auction//keyword
\ No newline at end of file
+++ /dev/null
-/site/closed_auctions/closed_auction[annotation/description/text/keyword]/date
\ No newline at end of file
+++ /dev/null
-/site/closed_auctions/closed_auction[descendant::keyword]/date
\ No newline at end of file
+++ /dev/null
-/site/people/person[profile/gender and profile/age]/name
\ No newline at end of file
+++ /dev/null
-/site/people/person[phone or homepage]/name
\ No newline at end of file
+++ /dev/null
-/site/people/person[address and (phone or homepage) and (creditcard or profile)]/name
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[parent::namerica or parent::samerica]/name
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) and (bidder/following::bidder and bidder/preceding::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-//keyword/ancestor::listitem/text/keyword
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction/bidder[following-sibling::bidder]
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction/bidder[preceding-sibling::bidder]
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[following::item]/name
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[preceding::item]/name
\ No newline at end of file
+++ /dev/null
-//person[profile/@income]/name
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[bidder and not(bidder/preceding-sibling::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) or (bidder/following::bidder and bidder/preceding::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-/site/people/person[profile/age >= 18 and profile/@income < 10000 and address/city != 'Dallas']/name
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[bidder/increase = current]/interval
\ No newline at end of file
+++ /dev/null
-/site/people/person[profile/@income = /site/open_auctions/open_auction/current]/name
\ No newline at end of file
+++ /dev/null
-/site/people/person[watches/watch/id(@open_auction)/seller/@person = @id]/name
\ No newline at end of file
+++ /dev/null
-id('person0')/name
\ No newline at end of file
+++ /dev/null
-/site/people/person/watches/watch/id(@open_auction)/interval
\ No newline at end of file
+++ /dev/null
-/site/people/person[watches/watch/id(@open_auction)/itemref/id(@item)/parent::australian]/name
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[(count(bidder) mod 2) = 0]/interval
\ No newline at end of file
+++ /dev/null
-count(//text) + count(//bold) + count(//emph) + count(//keyword)
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[sum(bidder/increase) > 10 * initial]/interval
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[sum(bidder/increase) != (current - initial)]/interval
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[bidder and (sum(bidder/increase) div count(bidder)) > 2 * initial]/interval"
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction[number(bidder[1]/increase) < number(bidder[floor((last() + 1) div 2)]/increase) and number(bidder[floor((last() + 1) div 2)]/increase) < number(bidder[last()]/increase)]/interval
\ No newline at end of file
+++ /dev/null
-/site/regions/europe/item/description/descendant::keyword[last()]
\ No newline at end of file
+++ /dev/null
-//keyword/ancestor::listitem[1]/text/keyword
\ No newline at end of file
+++ /dev/null
-/site/open_auctions/open_auction/bidder[number(preceding-sibling::bidder[1]/increase) <= number(increase) and number(increase) <= number(following-sibling::bidder[1]/increase)]
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[preceding::item[100] and following::item[100]]/name
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[contains(description, name)]/name
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[contains(substring-before(description, 'eros'), 'passion') and contains(substring-after(description, 'eros'), 'dangerous')]/name
\ No newline at end of file
+++ /dev/null
-/site/regions/*/item[string-length(translate(normalize-space(description),' ','')) > 10000]/name
\ No newline at end of file
+++ /dev/null
-/site/regions
+++ /dev/null
-/site/regions/*/item[mailbox/mail/from]/mailbox/mail
+++ /dev/null
-/site/regions/*/item[mailbox/mail/from]//keyword
+++ /dev/null
-//keyword/ancestor::listitem/parent::parlist
+++ /dev/null
-//keyword/ancestor::listitem
+++ /dev/null
-//keyword/ancestor-or-self::mail
+++ /dev/null
-/site/closed_auctions
+++ /dev/null
-/site/regions/europe/item/mailbox/mail/text/keyword
+++ /dev/null
-/site/closed_auctions/close_auction/annotation/description/parlist/listitem
+++ /dev/null
-/site/closed_auctions/close_auction/annotation/description/parlist/listitem/parlist/listitem/*//keyword
+++ /dev/null
-/site/regions/*/item
+++ /dev/null
-/descendant-or-self::listitem/descendant-or-self::keyword
+++ /dev/null
-/site/regions/*/item//keyword
+++ /dev/null
-/site/people[address and (name or homepage)]
+++ /dev/null
-doc()/site/closed_auctions/closed_auction/annotation/description/text/keyword
\ No newline at end of file
+++ /dev/null
-doc()//closed_auction//keyword
\ No newline at end of file
+++ /dev/null
-doc()/site/closed_auctions/closed_auction//keyword
\ No newline at end of file
+++ /dev/null
-doc()/site/closed_auctions/closed_auction[annotation/description/text/keyword]/date
\ No newline at end of file
+++ /dev/null
-doc()/site/closed_auctions/closed_auction[descendant::keyword]/date
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[profile/gender and profile/age]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[phone or homepage]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[address and (phone or homepage) and (creditcard or profile)]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[parent::namerica or parent::samerica]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) and (bidder/following::bidder and bidder/preceding::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-doc()//keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::parlist/descendant::keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword/ancestor::parlist/descendant::keyword
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::listitem/text/keyword
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction/bidder[following-sibling::bidder]
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction/bidder[preceding-sibling::bidder]
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[following::item]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[preceding::item]/name
\ No newline at end of file
+++ /dev/null
-doc()//person[profile/@income]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[bidder and not(bidder/preceding-sibling::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) or (bidder/following::bidder and bidder/preceding::bidder)]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[profile/age >= 18 and profile/@income < 10000 and address/city != 'Dallas']/name
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[bidder/increase = current]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[profile/@income = /site/open_auctions/open_auction/current]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[watches/watch/id(@open_auction)/seller/@person = @id]/name
\ No newline at end of file
+++ /dev/null
-doc()/id('person0')/name
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person/watches/watch/id(@open_auction)/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/people/person[watches/watch/id(@open_auction)/itemref/id(@item)/parent::australian]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[(count(bidder) mod 2) = 0]/interval
\ No newline at end of file
+++ /dev/null
-doc()/(count(//text) + count(//bold) + count(//emph) + count(//keyword))
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[sum(bidder/increase) > 10 * initial]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[sum(bidder/increase) != (current - initial)]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[bidder and (sum(bidder/increase) div count(bidder)) > 2 * initial]/interval"
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction[number(bidder[1]/increase) < number(bidder[floor((last() + 1) div 2)]/increase) and number(bidder[floor((last() + 1) div 2)]/increase) < number(bidder[last()]/increase)]/interval
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/europe/item/description/descendant::keyword[last()]
\ No newline at end of file
+++ /dev/null
-doc()//keyword/ancestor::listitem[1]/text/keyword
\ No newline at end of file
+++ /dev/null
-doc()/site/open_auctions/open_auction/bidder[number(preceding-sibling::bidder[1]/increase) <= number(increase) and number(increase) <= number(following-sibling::bidder[1]/increase)]
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[preceding::item[100] and following::item[100]]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[contains(description, name)]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[contains(substring-before(description, 'eros'), 'passion') and contains(substring-after(description, 'eros'), 'dangerous')]/name
\ No newline at end of file
+++ /dev/null
-doc()/site/regions/*/item[string-length(translate(normalize-space(description),' ','')) > 10000]/name
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/following-sibling::bidder[position()=1 and number(increase) <= 10]
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()//bidder[number(increase) <= 10 and (following-sibling::bidder[position()=1 and number(increase) > 10] or fun:closure(.,())/following-sibling::bidder[position()=1 and number(increase) > 10])]
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/preceding-sibling::bidder[position()=1 and number(increase) <= 10]
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()//bidder[number(increase) <= 10 and (preceding-sibling::bidder[position()=1 and number(increase) > 10] or fun:closure(.,())/preceding-sibling::bidder[position()=1 and number(increase) > 10])]
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/parlist/listitem/parlist/listitem
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()//listitem[text/keyword or fun:closure(.,())/text/keyword]/text/keyword
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/seller/id(@person)/watches/watch/id(@open_auction)
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()/site/open_auctions/open_auction[position() <= 5]/fun:closure(.,())/interval
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/watches/watch/id(@open_auction)/bidder/personref/id(@person)
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()/site/people/person[position() <= 5]/fun:closure(.,())/name
+++ /dev/null
-doc()/site/people/person[1]/idref(@id)/..
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := ($input | doc()//edge[@from = $input]/@to)
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()//category[@id="category0"]/@id/fun:closure(.,())/id(.)/name
\ No newline at end of file
+++ /dev/null
-declare namespace fun = 'have.more.fun';
-
-declare function fun:closure($input as node()*, $result as node()*) as node()*
-{
- let $current := $input/idref(.)[name() = "from"]/../@to
- let $new := $current except $result
- let $all := ($result,$new)
-
- return
- if(exists($new))
- then ($new, fun:closure($new,$all))
- else ()
-};
-
-doc()//category[@id="category0"]/@id/fun:closure(.,())/id(.)/name
+++ /dev/null
-doc()/site/regions
+++ /dev/null
-doc()/site/regions/*/item[mailbox/mail/from]/mailbox/mail
+++ /dev/null
-doc()/site/regions/*/item[mailbox/mail/from]//keyword
+++ /dev/null
-doc()//keyword/ancestor::listitem/parent::parlist
+++ /dev/null
-doc()//keyword/ancestor::listitem
+++ /dev/null
-doc()//keyword/ancestor-or-self::mail
+++ /dev/null
-doc()/site/closed_auctions
+++ /dev/null
-doc()/site/regions/europe/item/mailbox/mail/text/keyword
+++ /dev/null
-doc()/site/closed_auctions/close_auction/annotation/description/parlist/listitem
+++ /dev/null
-doc()/site/closed_auctions/close_auction/annotation/description/parlist/listitem/parlist/listitem/*//keyword
+++ /dev/null
-doc()/site/regions/*/item
+++ /dev/null
-doc()/descendant-or-self::listitem/descendant-or-self::keyword
+++ /dev/null
-doc()/site/regions/*/item//keyword
+++ /dev/null
-doc()/site/people[address and (name or homepage)]
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/closed_auctions/closed_auction/annotation/description/text/keyword"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="//closed_auction//keyword"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/closed_auctions/closed_auction//keyword"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/closed_auctions/closed_auction[annotation/description/text/keyword]/date"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/closed_auctions/closed_auction[descendant::keyword]/date"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[profile/gender and profile/age]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[phone or homepage]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[address and (phone or homepage) and (creditcard or profile)]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[parent::namerica or parent::samerica]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) and (bidder/following::bidder and bidder/preceding::bidder)]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="//keyword/ancestor::listitem/text/keyword"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction/bidder[following-sibling::bidder]"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction/bidder[preceding-sibling::bidder]"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[following::item]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[preceding::item]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="//person[profile/@income]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[bidder and not(bidder/preceding-sibling::bidder)]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[(not(bidder/following::bidder) or not(bidder/preceding::bidder)) or (bidder/following::bidder and bidder/preceding::bidder)]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[profile/age >= 18 and profile/@income < 10000 and address/city != 'Dallas']/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[bidder/increase = current]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[profile/@income = /site/open_auctions/open_auction/current]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[watches/watch/id(@open_auction)/seller/@person = @id]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="id('person0')/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person/watches/watch/id(@open_auction)/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/people/person[watches/watch/id(@open_auction)/itemref/id(@item)/parent::australian]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[(count(bidder) mod 2) = 0]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="count(//text) + count(//bold) + count(//emph) + count(//keyword)"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[sum(bidder/increase) > 10 * initial]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[sum(bidder/increase) != (current - initial)]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[bidder and (sum(bidder/increase) div count(bidder)) > 2 * initial]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction[number(bidder[1]/increase) < number(bidder[floor((last() + 1) div 2)]/increase) and number(bidder[floor((last() + 1) div 2)]/increase) < number(bidder[last()]/increase)]/interval"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/europe/item/description/descendant::keyword[last()]"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="//keyword/ancestor::listitem[1]/text/keyword"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/open_auctions/open_auction/bidder[number(preceding-sibling::bidder[1]/increase) <= number(increase) and number(increase) <= number(following-sibling::bidder[1]/increase)]"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[preceding::item[100] and following::item[100]]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[contains(description, name)]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="site/regions/*/item[contains(substring-before(description, 'eros'), 'passion') and contains(substring-after(description, 'eros'), 'dangerous')]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-<?xml version="1.0"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
- <xsl:template match="/">
- <xsl:copy-of select="/site/regions/*/item[string-length(translate(normalize-space(description),' ','')) > 10000]/name"/>
- </xsl:template>
-</xsl:stylesheet>
\ No newline at end of file
+++ /dev/null
-#!/bin/sh
-
-DISPLAY=0
-case "$1" in
- [A-Z])
- SERIE="$1";;
- [A-Z][0-9]*)
- DISPLAY=1
- SERIE="$1";;
- *)
- SERIE="";;
-esac
-
-
-for i in xpath-pt/xpath/$SERIE*
-do
-querybase=`basename "$i" .xpl`
-query=`cat $i`
-
-xqueryorig="xpath-pt/xquery/$querybase".xql
-cat $xqueryorig | sed -e "s/doc()/doc(\"xmark_test.xml\")/g" >tmp.xql
-../main xmark_test.xml "$query" results/"$querybase".sxsi
-saxonb-xquery -o:results/"$querybase".saxon tmp.xql
-echo >> results/"$querybase".saxon
-diff -w results/"$querybase".sxsi results/"$querybase".saxon >/dev/null || echo $querybase gives different results
-done
-
-if [ "$DISPLAY" = "1" ]
-then
-./show.sh "$SERIE"
-fi
-
val first_child : t -> t
val next_sibling : t -> t
val parent : t -> t
+ val root : t -> t
+ val is_root : t -> bool
val id : t -> int
val tag : t -> Tag.t
val print_xml_fast : out_channel -> t -> unit
with type elt = string_content
val string_below : t -> string_content -> bool
val contains : t -> string -> DocIdSet.t
- val contains_old : t -> string -> bool
+ val contains_old : t -> string -> DocIdSet.t
+ val contains_iter : t -> string -> DocIdSet.t
+ val count_contains : t -> string -> int
+ val count : t -> string -> int
val dump : t -> unit
val get_string : t -> string_content -> string
val has_tagged_desc : t -> Tag.t -> bool
val tagged_foll : t -> Tag.t -> t
val tagged_next : t -> Tag.t -> t
val subtree_tags : t -> Tag.t -> int
+ val is_left : t -> bool
end
module XML =
external get_cached_text : t -> [`Text ] node -> string = "caml_text_collection_get_cached_text"
+
let get_text t n =
if (equal nil n) || is_empty t n then ""
else get_cached_text t n
+ external size : t -> int = "caml_text_collection_size"
external is_contains : t -> string -> bool = "caml_text_collection_is_contains"
external count_contains : t -> string -> int = "caml_text_collection_count_contains"
+ external count : t -> string -> int = "caml_text_collection_count"
external contains : t -> string -> [`Text ] node array = "caml_text_collection_contains"
end
| Node (SC (t,i)) -> Printf.sprintf "Node (SC (%i,%i))" (int_of_node t) (int_of_node i)
+ let root n = { n with node = norm (Tree.root n.doc) }
+ let is_root n = match n.node with
+ | Node(NC t) when (Tree.root n.doc) == t -> true
+ | _ -> false
+
let parent n =
let node' =
match n.node with
- | Node(NC t) | Node(SC (_,t)) ->
- if (Tree.root n.doc) == t
- then Nil
- else Node(NC(Tree.parent n.doc t)) (* A parent node can never be a SC *)
- | _ -> assert false
+ | Node(NC t) ->
+ let txt = prev_text n.doc t in
+ if Text.is_empty n.doc txt then
+ Node(NC (Tree.parent n.doc t))
+ else
+ Node(SC (txt,t))
+ | Node(SC(t,_)) -> Node (NC(parent_doc n.doc t))
+ | _ -> failwith "parent"
in
{ n with node = node' }
let contains t s =
Array.fold_left (fun a i -> DocIdSet.add i a) DocIdSet.empty (Text.contains t.doc s)
+
let contains_old t s =
let regexp = Str.regexp_string s in
let matching arg =
in true
with _ -> false
in
- let rec find t = match t.node with
- | Nil -> false
- | String _ -> matching (string t)
- | Node(_) -> (find (left t )) || (find (right t))
+ let rec find t acc = match t.node with
+ | Nil -> acc
+ | String i ->
+ if matching (string t) then DocIdSet.add i acc else acc
+ | Node(_) -> (find (left t )) ((find (right t)) acc)
+ in
+ find t DocIdSet.empty
+
+
+ let contains_iter t s =
+ let regexp = Str.regexp_string s in
+ let matching arg =
+ try
+ let _ = Str.search_forward regexp arg 0;
+ in true
+ with _ -> false
+ in
+ let size = Text.size t.doc in
+ let rec find acc n =
+ if n == size then acc
+ else
+ find
+ (if matching (Text.get_cached_text t.doc (Obj.magic n)) then
+ DocIdSet.add (Obj.magic n) acc
+ else acc) (n+1)
in
- find t
+ find DocIdSet.empty 0
+
+
+
+
+ let count_contains t s = Text.count_contains t.doc s
+ let count t s = Text.count t.doc s
+
+ let is_left t =
+ let u = left (parent t) in
+ (id t) == (id u)
let print_xml_fast outc t =
let rec loop ?(print_right=true) t = match t.node with
val first_child : t -> t
val next_sibling : t -> t
val parent : t -> t
+ val root : t -> t
+ val is_root : t -> bool
val id : t -> int
val tag : t -> Tag.t
val print_xml_fast : out_channel -> t -> unit
end with type elt = string_content
val string_below : t -> string_content -> bool
val contains : t -> string -> DocIdSet.t
- val contains_old : t -> string -> bool
+ val contains_old : t -> string -> DocIdSet.t
+ val contains_iter : t -> string -> DocIdSet.t
+ val count_contains : t -> string -> int
+ val count : t -> string -> int
val dump : t -> unit
val get_string : t -> string_content -> string
val has_tagged_desc : t -> Tag.t -> bool
val tagged_foll : t -> Tag.t -> t
val tagged_next : t -> Tag.t -> t
val subtree_tags : t -> Tag.t -> int
+ val is_left : t -> bool
end
module Binary : BINARY
then `True (*`Right(fun t ->
TagSet.exists (fun tag -> Tree.Binary.has_tagged_foll t tag)
test) *)
- else `True )>=> `Right ** q_src
+ else `True )>=>
+ if ex then ( Ata.atom_ `Left false q_src) *& `Right ** q_src
+ else `Right ** q_src
in
let _ = add_trans num conf.tr_aux t3
in
Ata.phi = phi;
Ata.delta = Hashtbl.create 17;
Ata.sigma = Ata.HTagSet.create 17;
- }
+ },[]
end
end
module Compile :
sig
-val compile : Ast.path -> Ata.t
+val compile : Ast.path -> Ata.t * (Tag.t*Ptset.t) list
end
projects / SXSI / xpathcomp.git / commitdiff