Merged from branch stable-succint-refactor

[SXSI/xpathcomp.git] / automaton.ml

diff --git a/automaton.ml b/automaton.ml
index 27c8264..0c815a4 100644 (file)
--- a/automaton.ml
+++ b/automaton.ml
@@ -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