.

[SXSI/xpathcomp.git] / automaton.ml

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