open Ata.Transitions
-let add_trans num htr ((q,_,_,_) as tr) =
+let add_trans num htr ((q,_,_,_,_) as tr) =
try
let (i,ltr) = Hashtbl.find htr q in
if List.exists (Ata.equal_trans tr) ltr
exception Exit of Ata.state * Ata.transition list
let rec replace s f =
match f.Ata.pos with
- | Ata.Atom(_,b,q,_) when q = s -> if b then Ata.true_ else Ata.false_
+ | Ata.Atom(_,b,q) when q = s -> if b then Ata.true_ else Ata.false_
| Ata.Or(f1,f2) -> (replace s f1) +| (replace s f2)
| Ata.And(f1,f2) -> (replace s f1) *& (replace s f2)
| _ -> f
let or_self conf old_dst q_src q_dst dir test pred mark =
try
let (num,l) = Hashtbl.find conf.tr q_src in
- let l2 = List.fold_left (fun acc (q,t,m,f) ->
- (q,TagSet.cap t test,mark,
+ let l2 = List.fold_left (fun acc (q,t,m,f,_) ->
+ (q,
+ TagSet.cap t test,
+ mark,
(if mark then replace old_dst f else f)
*& pred *&
- (if mark then Ata.true_ else (_l dir) ** q_dst))::acc)
+ (if mark then Ata.true_ else (_l dir) ** q_dst),
+ `True)::acc)
l l
in Hashtbl.replace conf.tr q_src (num,l2)
with Not_found -> ()
| 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
+ 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
in
- let t1 = ?< q_src><(test, is_last && not(existential))>=>
+ let t1 = ?< q_src><(test, is_last && not(ex))>=>
p_f *& (if is_last then Ata.true_ else (_l dir) ** q_dst) in
- let t2 = ?< q_src><(TagSet.star, false)>=>
- (if axis=Descendant then `Left ** q_src +|`Right ** q_src
- else `Right ** q_src) in
- let tsa = ?< q_src><(att_or_str, false)>=> `Right ** q_src
+
+ 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 )
+ in
+ let t3 =
+ ?< q_src><@ ((if ex then TagSet.diff TagSet.any test
+ 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 )>=> `Right ** q_src
+ in
+ let _ = add_trans num conf.tr_aux t3
in
- add_trans num conf.tr t1;
- add_trans num conf.tr_aux t2;
- add_trans num conf.tr_aux tsa;
[q_dst], q_dst,
(if axis = FollowingSibling then hpush q_src ctx_path else vpush q_src ctx_path)
-
+
| Attribute ->
let q_dstreal = Ata.mk_state() in
(* attributes are always the first child *)
(`Left** q0) *& (if config.has_backward then `Left ** config.st_from_root else Ata.true_)
in
add_trans num config.tr fst_tr;
- if config.has_backward then begin
+ if config.has_backward then begin
add_trans num config.tr_aux
(?< (config.st_from_root) >< (TagSet.star,false) >=> `Left ** config.st_from_root +|
`Right ** config.st_from_root);
add_trans num config.tr_aux
(?< (config.st_from_root) >< (TagSet.cup TagSet.pcdata TagSet.attribute,false) >=>
- `Right ** config.st_from_root);
+ `Right ** config.st_from_root);
- end;
+ end;
let phi = Hashtbl.create 37 in
- let fadd = fun _ (_,l) -> List.iter (fun (s,t,m,f) -> Hashtbl.add phi (t,s) (m,f)) l in
+ let fadd = fun _ (_,l) -> List.iter (fun (s,t,m,f,p) ->
+ let lt = try
+ Hashtbl.find phi s
+ with Not_found -> []
+ in
+ Hashtbl.replace phi s ((t,(m,f,p))::lt)
+ ) l in
Hashtbl.iter (fadd) config.tr;
Hashtbl.iter (fadd) config.tr_aux;
Hashtbl.iter (fadd) config.tr_parent_loop;
let final =
- let s = Ptset.union anc_st (Ptset.from_list [a_dst;config.st_univ])
- in if has_backward then s else Ptset.add config.st_from_root s
+ let s = Ptset.union anc_st (Ptset.from_list [])
+ in if has_backward then Ptset.add config.st_from_root s else s
in { Ata.id = Oo.id (object end);
- Ata.states = a_st;
+ 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.universal = Ptset.union anc_st config.final_state;
Ata.phi = phi;
Ata.delta = Hashtbl.create 17;
- Ata.properties = Hashtbl.create 0;
+ Ata.sigma = Ata.HTagSet.create 17;
}
projects / SXSI / xpathcomp.git / blobdiff