Some more bugfixing for the contains.

[SXSI/xpathcomp.git] / xPath.ml

diff --git a/xPath.ml b/xPath.ml
index 6c88d9a..6dfde87 100644 (file)
--- a/xPath.ml
+++ b/xPath.ml
@@ -215,6 +215,8 @@ module Functions = struct
 
   let text t = Tree.Binary.string (Tree.Binary.left t)
 
+    
+
   let rec eval_expr tree (e:expr) : value = match e with 
     | `Call (f,args) -> (List.assoc f globals) (List.map (eval_expr tree) args)
     | `Auto(a) -> `NodeSet(ignore (Automaton.BottomUp.accept a tree);
@@ -223,8 +225,17 @@ module Functions = struct
        begin
          match args with
              [ `Auto(a); `String(s) ] ->
-               let docs = Tree.Binary.contains tree s
-               in 
+               let docs = try
+                 Hashtbl.find a.Automaton.contains s
+                   with
+                     | Not_found -> 
+                         let r = Tree.Binary.contains tree s
+                         in
+                           (* Tree.Binary.DocIdSet.iter (fun id -> 
+                              Printf.eprintf "%s matches %s\n%!" (Tree.Binary.get_string tree id) s) r; *)
+                           
+                           Hashtbl.add a.Automaton.contains s r;r
+               in  
                let _ = Automaton.BottomUp.accept ~strings:(Some docs) a tree
                in `NodeSet(a.Automaton.result)         
            | _ -> failwith "contains invalid"
@@ -303,13 +314,16 @@ module Compile = struct
     let rec map_dir (d,acc) = function
       | [] -> acc
       | s::r -> map_dir ((dir s),(s,d)::acc) r
-    in let l = match p with
-      | Absolute p | Relative p -> map_dir (Final,[]) p
-      | AbsoluteDoS p -> 
-         let l = (map_dir (Final,[]) p)
-         in ((DescendantOrSelf,TagSet.Xml.node,Expr True),dir (fst(List.hd l)))::l
-    in ((Child,TagSet.Xml.node,Expr True),dir (fst(List.hd l)))::l
-
+    in 
+    let l = 
+      match p with
+       | Absolute p 
+       | Relative p -> map_dir (Final,[]) p        
+       | AbsoluteDoS p -> 
+           let l = (map_dir (Final,[]) p)
+           in ((DescendantOrSelf,TagSet.Xml.node,Expr True),dir (fst(List.hd l)))::l
+  in ((Child,TagSet.Xml.node,Expr True),dir (fst(List.hd l)))::l
+       
 
   let rec compile_step q dir trs final initial ignore (axis,test,pred) = 
     let q' = State.mk() in