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

diff --git a/automaton.ml b/automaton.ml
index 12eee0b..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 =
@@ -304,11 +307,11 @@ struct
   let mem s x =  SSet.mem x s
 
 
-  let rec accepting_among ?(strings=None)auto t r = 
+  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 )
+	| Some valid_strings when Tree.Binary.DocIdSet.for_all (fun i -> not(Tree.Binary.string_below t i)
+							       ) valid_strings 
 	    -> SSet.empty
 	| _ -> (
 	    
@@ -322,7 +325,8 @@ struct
 	    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 
+		  -> Printf.eprintf "Selecting string '%s'\n%!" (Tree.Binary.get_string t id);
+		  SSet.inter r auto.final 
 	      | _ -> SSet.empty
 	  )			    
 	| Tree.Binary.Node(_) -> 
@@ -349,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)
@@ -364,7 +369,7 @@ struct
 	    
   let accept ?(strings=None) auto t =
     auto.result <- BST.empty;
-    if SSet.is_empty (accepting_among ~strings:strings auto t auto.initial)
+    if SSet.is_empty (accepting_among ~nobrother:true ~strings:strings auto t auto.initial)
     then false
     else true
 end