| [ "." ; p = top_pred -> [(Self,TagSet.node,p)] ]
| [ ".." ; p = top_pred -> [(Parent,TagSet.star,p)] ]
| [ "." ; p = top_pred -> [(Self,TagSet.node,p)] ]
| [ ".." ; p = top_pred -> [(Parent,TagSet.star,p)] ]
+| [ "contains"; "(" ; s = STRING ; ")";p=top_pred -> [
+ let _ = contains := Some(s) in (Child,TagSet.singleton Tag.pcdata, p)]
+ ]
+| [ "contains_full"; "(" ; s = STRING ; ")";p=top_pred -> [
+ let _ = contains := Some(s) in (Descendant,TagSet.singleton Tag.pcdata, p)]
+ ]
| [ test = test; p = top_pred -> [(Child,test, p)] ]
| [ att = ATT ; p = top_pred ->
match att with
| [ test = test; p = top_pred -> [(Child,test, p)] ]
| [ att = ATT ; p = top_pred ->
match att with
tr_parent_loop : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
tr : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
tr_aux : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
tr_parent_loop : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
tr : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
tr_aux : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
(if mark then replace old_dst f else f)
*& pred *&
(if mark then Ata.true_ else (_l dir) ** q_dst),
(if mark then replace old_dst f else f)
*& pred *&
(if mark then Ata.true_ else (_l dir) ** q_dst),
| (x,z::y) ::r -> z,(x,y)::r
| _-> assert false
| (x,z::y) ::r -> z,(x,y)::r
| _-> assert false
let ex = existential in
let axis,test,pred = step in
let is_last = dir = `Last in
let ex = existential in
let axis,test,pred = step in
let is_last = dir = `Last in
let p_st, p_anc, p_par, p_pre, p_num, p_f =
compile_pred conf q_src num ctx_path dir pred q_dst
in
let p_st, p_anc, p_par, p_pre, p_num, p_f =
compile_pred conf q_src num ctx_path dir pred q_dst
in
- | Child | FollowingSibling | Descendant | DescendantOrSelf ->
- let axis =
- if axis = DescendantOrSelf
- then
- begin
- or_self conf q_src (fst(vpop ctx_path)) q_dst dir test p_f (is_last && not(existential));
- Descendant
- end
- else axis
+
+ | Child | Descendant ->
+ let left,right =
+ if nrec then `LLeft,`RRight
+ else `Left,`Right
let _ = add_trans num conf.tr t1 in
let _ = if axis=Descendant then
add_trans num conf.tr_aux (
let _ = add_trans num conf.tr t1 in
let _ = if axis=Descendant then
add_trans num conf.tr_aux (
- ?< q_src><@ ((if ex then TagSet.diff TagSet.star test
- else TagSet.star),false,
- if TagSet.is_finite test
- then `Left(fun t ->
- if (Tree.Binary.is_node t)
- then
- let mytag = Tree.Binary.tag t in
- TagSet.exists (fun tag ->
- tag == mytag ||
- Tree.Binary.has_tagged_desc t tag
- )
- test
- else true
- )
-
- else `True )>=> `Left ** q_src )
+ ?< q_src><@ ((if ex||nrec then TagSet.diff TagSet.star test
+ else TagSet.star),false)>=> `LLeft ** q_src )
- else TagSet.any), false,
- if axis=Descendant&&TagSet.is_finite test
- then `True (*`Right(fun t ->
- TagSet.exists (fun tag -> Tree.Binary.has_tagged_foll t tag)
- test) *)
- else `True )>=>
- if ex then ( Ata.atom_ `Left false q_src) *& `Right ** q_src
- else `Right ** q_src
+ else TagSet.any), false)>=>
+ if ex then right ** q_src
+ else (if axis=Descendant then `RRight else `Right) ** q_src
in
let _ = if axis = AncestorOrSelf then
or_self conf q_src (fst(vpop ctx_path)) q_dst dir test p_f (is_last && not(existential));
in
let _ = if axis = AncestorOrSelf then
or_self conf q_src (fst(vpop ctx_path)) q_dst dir test p_f (is_last && not(existential));
let fc = List.fold_left (fun f s -> ((_l dir)**s +|f)) Ata.false_ up_states
in
let t1 = ?< q_frm_root><(test,is_last && (not existential) )>=>
let fc = List.fold_left (fun f s -> ((_l dir)**s +|f)) Ata.false_ up_states
in
let t1 = ?< q_frm_root><(test,is_last && (not existential) )>=>
add_trans num conf.tr t1;
[q_dst ], q_dst, vpush q_frm_root new_ctx
add_trans num conf.tr t1;
[q_dst ], q_dst, vpush q_frm_root new_ctx
- (fun (a_st,a_dst,anc_st,par_st,pre_st,ctx_path,num,has_backward) (step,dir) ->
+ (fun (a_st,a_dst,anc_st,par_st,pre_st,ctx_path,num,has_backward,a_isrec) (step,dir) ->
in
let new_states = Ptset.union (Ptset.from_list add_states) a_st in
let nanc_st,npar_st,npre_st,new_bw =
in
let new_states = Ptset.union (Ptset.from_list add_states) a_st in
let nanc_st,npar_st,npre_st,new_bw =
|(Parent|Ancestor|AncestorOrSelf),_,_ -> Ptset.add a_dst anc_st,par_st,pre_st,true
| _ -> anc_st,par_st,pre_st,has_backward
in
|(Parent|Ancestor|AncestorOrSelf),_,_ -> Ptset.add a_dst anc_st,par_st,pre_st,true
| _ -> anc_st,par_st,pre_st,has_backward
in
- new_states,new_dst,nanc_st,npar_st,npre_st,new_ctx, num+1,new_bw
+ new_states,new_dst,nanc_st,npar_st,npre_st,new_ctx, num+1,new_bw,(match a_isrec with [] -> [] | _::r -> r)
- (states, q_src, Ptset.empty,Ptset.empty,Ptset.empty, ctx_path,idx, false )
+ (states, q_src, Ptset.empty,Ptset.empty,Ptset.empty, ctx_path,idx, false,(List.tl annot_path) )
and binop_ conf q_src idx ctx_path dir pred p1 p2 f ddst =
let a_st1,anc_st1,par_st1,pre_st1,idx1,f1 =
compile_pred conf q_src idx ctx_path dir p1 ddst in
and binop_ conf q_src idx ctx_path dir pred p1 p2 f ddst =
let a_st1,anc_st1,par_st1,pre_st1,idx1,f1 =
compile_pred conf q_src idx ctx_path dir p1 ddst in
| Path (p) ->
let q = Ata.mk_state () in
let annot_path = match p with Relative(r) -> dirannot (List.rev r) | _ -> assert false in
| Path (p) ->
let q = Ata.mk_state () in
let annot_path = match p with Relative(r) -> dirannot (List.rev r) | _ -> assert false in
- let a_st,a_dst,anc_st,par_st,pre_st,_,idx,has_backward =
+ let a_st,a_dst,anc_st,par_st,pre_st,_,idx,has_backward,_ =
compile_path ~existential:true annot_path conf q states idx ctx_path
in
let ret_dir = match annot_path with
compile_path ~existential:true annot_path conf q states idx ctx_path
in
let ret_dir = match annot_path with
let _ = match annot_path with
| (((Parent|Ancestor|AncestorOrSelf),_,_),_)::_ -> conf.final_state <- Ptset.add qdst conf.final_state
| _ -> ()
let _ = match annot_path with
| (((Parent|Ancestor|AncestorOrSelf),_,_),_)::_ -> conf.final_state <- Ptset.add qdst conf.final_state
| _ -> ()
(a_st,anc_st,par_st,pre_st,idx, ((ret_dir) ** q))
| True -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.true_
| False -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.false_
(a_st,anc_st,par_st,pre_st,idx, ((ret_dir) ** q))
| True -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.true_
| False -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.false_
let config = { st_root = Ata.mk_state();
st_univ = Ata.mk_state();
final_state = Ptset.empty;
let config = { st_root = Ata.mk_state();
st_univ = Ata.mk_state();
final_state = Ptset.empty;
add_trans num config.tr_aux (mk_star config.st_from_root `Left config.st_from_root config.st_univ);
add_trans num config.tr_aux (mk_step config.st_no_nil (TagSet.add Tag.pcdata TagSet.star) `Left config.st_univ config.st_univ);
*)
add_trans num config.tr_aux (mk_star config.st_from_root `Left config.st_from_root config.st_univ);
add_trans num config.tr_aux (mk_step config.st_no_nil (TagSet.add Tag.pcdata TagSet.star) `Left config.st_univ config.st_univ);
*)
- let a_st,a_dst,anc_st,par_st,pre_st,_,_,has_backward =
+ let a_st,a_dst,anc_st,par_st,pre_st,_,_,has_backward,_ =
- ?< (config.st_root) >< (TagSet.star,false) >=>
- (`Left** q0) *& (if config.has_backward then `Left ** config.st_from_root else Ata.true_)
+ ?< (config.st_root) >< (TagSet.singleton (Tag.tag ""),false) >=>
+ ((if is_rec dirsteps then `LLeft else `Left)** q0) *& (if config.has_backward then `LLeft ** config.st_from_root else Ata.true_)
- (?< (config.st_from_root) >< (TagSet.star,false) >=> `Left ** config.st_from_root +|
- `Right ** config.st_from_root);
+ (?< (config.st_from_root) >< (TagSet.star,false) >=> `LLeft ** config.st_from_root);
- (?< (config.st_from_root) >< (TagSet.cup TagSet.pcdata TagSet.attribute,false) >=>
- `Right ** config.st_from_root);
+ (?< (config.st_from_root) >< (TagSet.any,false) >=>
+ `RRight ** config.st_from_root);
Ata.states = if has_backward then Ptset.add config.st_from_root a_st else a_st;
Ata.init = Ptset.singleton config.st_root;
Ata.final = Ptset.union anc_st config.final_state;
Ata.states = if has_backward then Ptset.add config.st_from_root a_st else a_st;
Ata.init = Ptset.singleton config.st_root;
Ata.final = Ptset.union anc_st config.final_state;