.

[SXSI/xpathcomp.git] / automaton.ml

diff --git a/automaton.ml b/automaton.ml
index 5c09143..12eee0b 100644 (file)
--- a/automaton.ml
+++ b/automaton.ml
@@ -287,7 +287,6 @@ let mk () = { initial = SSet.empty;
 module BottomUp =  
 struct 
 
-                
   exception Fail
     
   let pr_states fmt st = SSet.iter (fun s -> State.print fmt s;
@@ -303,17 +302,29 @@ struct
       loop ([],SSet.empty) l
 
   let mem s x =  SSet.mem x s
-  let rec accepting_among auto t r = 
-    if SSet.is_empty r then r else
-    
+
+
+  let rec accepting_among ?(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 | Tree.Binary.String _ -> 
-           let i = SSet.inter r auto.final in i
-                                                           
+       | 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)
+                 -> SSet.inter r auto.final 
+             | _ -> SSet.empty
+         )                         
        | Tree.Binary.Node(_) -> 
            let t1 = Tree.Binary.left t
            and t2 = Tree.Binary.right t
@@ -348,18 +359,17 @@ struct
              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
+    in SSet.union to_ignore res)
              
            
-  let accept auto t =
+  let accept ?(strings=None) auto t =
     auto.result <- BST.empty;
-    if SSet.is_empty (accepting_among auto t auto.initial)
+    if SSet.is_empty (accepting_among ~strings:strings auto t auto.initial)
     then false
     else true
 end
-module TopDown = struct
- 
 
+module TopDown = struct
   let rec accept_at auto t q =
     if SSet.mem q auto.ignore then true
     else 
@@ -384,7 +394,10 @@ module TopDown = struct
                  then
                    begin
                      if (SSet.mem q1 auto.marking)||(SSet.mem q2 auto.marking)
-                     then auto.result <- BST.add t auto.result;
+                     then 
+                       begin 
+                         auto.result <- BST.add t auto.result;
+                       end;
                      iter_trans true r
                    end
                  else 
@@ -447,3 +460,4 @@ module TopDown = struct
       run_in auto t auto.initial
 
 end
+