X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=automaton.ml;h=27c82645f85b92d994c51ceb7e10473cb4e1847d;hb=9abf8a6f78264fbf4eec1676b4a26018967c97e6;hp=5c09143656e095e9a452fbf0178f1c6f6b572fb3;hpb=3623eefccfb5fc69e19ad975a3669f51a2a8b276;p=SXSI%2Fxpathcomp.git

diff --git a/automaton.ml b/automaton.ml
index 5c09143..27c8264 100644
--- a/automaton.ml
+++ b/automaton.ml
@@ -28,8 +28,8 @@ struct
   let mem e s = ((1 lsl e) land s) != 0
   let add e s = (1 lsl e) lor s
   let singleton e = (1 lsl e)
-  let union = (lor)
-  let inter = (land)
+  let union a b = a lor b
+  let inter a b = a land b
   let diff a b = a land (lnot b)
   let remove e s = (lnot (1 lsl e) land s)
   let compare = (-)
@@ -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
+