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

diff --git a/automaton.ml b/automaton.ml
index 5c09143..0c815a4 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 = (-)
@@ -228,6 +228,7 @@ type t = { initial : SSet.t;
 	   (* Statistics *)
 	   mutable numbt : int;
 	   mutable max_states : int;
+	   contains : (string,Tree.Binary.DocIdSet.t) Hashtbl.t;
 	   }
 
 let mk () = { initial = SSet.empty;
@@ -237,7 +238,9 @@ let mk () = { initial = SSet.empty;
 	     ignore = SSet.empty;
 	     result = BST.empty; 
 	     numbt = 0;
-	     max_states = 0
+	     max_states = 0;
+	     contains = Hashtbl.create 37;
+    
 	   };;
 
   let print_tags fmt l =
@@ -287,7 +290,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 +305,30 @@ 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 ?(nobrother=false) ?(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)
+		  -> Printf.eprintf "Selecting string '%s'\n%!" (Tree.Binary.get_string t id);
+		  SSet.inter r auto.final 
+	      | _ -> SSet.empty
+	  )			    
 	| Tree.Binary.Node(_) -> 
 	    let t1 = Tree.Binary.left t
 	    and t2 = Tree.Binary.right t
@@ -338,7 +353,8 @@ struct
 		(fun x->SSet.mem (Transition.dest1 x) s1)
 		Transition.dest2 transitions
 	    in
-	    let s2 = accepting_among auto t2 r2
+	    let s2 = if nobrother then SSet.union (SSet.inter r auto.final) to_ignore
+	      else accepting_among auto t2 r2
 	    in
 	    let _,s = filter_map_rev
 	      (fun x -> SSet.mem (Transition.dest2 x) s2)
@@ -348,18 +364,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 ~nobrother:true ~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 +399,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 +465,4 @@ module TopDown = struct
       run_in auto t auto.initial
 
 end
+