X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=xPath.ml;h=2c520a1259494e0218d3549603504f4f41b76079;hb=5b4679e20761058f1e04c123da52631c0dd265cc;hp=ecfd4bdd7f7348fdddc337194d1ed5417ed4c5be;hpb=d64e3a3a9ef6329caafdba848ef78427fce0d689;p=SXSI%2Fxpathcomp.git

diff --git a/xPath.ml b/xPath.ml
index ecfd4bd..2c520a1 100644
--- a/xPath.ml
+++ b/xPath.ml
@@ -243,7 +243,7 @@ let _l =   function (`Left|`Last) -> `Left
 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
@@ -255,7 +255,7 @@ let add_trans num htr ((q,_,_,_) as tr) =
 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
@@ -264,11 +264,14 @@ let rec replace s 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 -> () 
@@ -308,25 +311,53 @@ let rec compile_step  ?(existential=false) conf q_src dir ctx_path step num =
     | 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 *)
@@ -482,31 +513,37 @@ let compile path =
 	      (`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;
 	       }