bug fixes, added the count queries

[SXSI/xpathcomp.git] / ata.ml

diff --git a/ata.ml b/ata.ml
index d17c0c8..fc29e98 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -706,6 +706,73 @@ type t = {
       let st,res = accepting_among a t a.init t in
         if Ptset.is_empty (st) then TS.empty else res
 
+    let rec accepting_among_count a t r ctx =     
+      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 ((ls,lls),(rs,rrs)),formula,mark,has_true,r' =
+             let tag =  Tree.tag t in
+               get_trans t a tag r
+           in 
+           let tl = tags a ls
+           and tr = tags a rs
+           and tll = tags a lls
+           and trr = tags a rrs
+           in          
+           let first =
+             if Ptset.mem Tag.pcdata (pt_cup tl tll)
+             then
+               Tree.text_below t
+             else
+               let etl = Ptset.is_empty tl
+               and etll = Ptset.is_empty tll
+               in
+                 if etl && etll 
+                 then Tree.mk_nil t
+                 else
+                   if etl then Tree.tagged_desc_only t tll
+                   else if etll then  Tree.first_child t
+                   else (* add child only *)                   
+                     Tree.tagged_below t tl tll 
+           and next =  
+             if Ptset.mem Tag.pcdata (pt_cup tr trr)
+             then
+               Tree.text_next t ctx
+             else
+               let etr = Ptset.is_empty tr
+               and etrr = Ptset.is_empty trr
+               in
+                   if etr && etrr 
+                   then Tree.mk_nil t
+                   else
+                     if etr then Tree.tagged_foll_only t trr ctx
+                     else if etrr then Tree.next_sibling t
+                     else (* add ns only *)                    
+                       Tree.tagged_next t tr trr ctx
+                         
+           in
+           let s1,res1 = accepting_among_count a first (pt_cup ls lls) t
+           and s2,res2 =  accepting_among_count a next (pt_cup rs rrs) ctx
+           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', res2 + (if mark then  1 + res1 else res1)
+               else Ptset.empty,0
+                 
+                 
+                 
+         else orig,0
+
+           
+    let run_count a t = 
+      let st,res = accepting_among_count a t a.init t in
+        if Ptset.is_empty (st) then 0 else res