X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=xPath.ml;h=6dfde8789cd5fa574cae0ff5bd4953353c05f911;hb=c74aa5a224a41d3ab9d1a7ae4ebb4e58083a578c;hp=661863d677524d227f5c65dc8ea58feb8b1ee879;hpb=280fbebb046069cea454507fa7933b4330bff1eb;p=SXSI%2Fxpathcomp.git

diff --git a/xPath.ml b/xPath.ml
index 661863d..6dfde87 100644
--- a/xPath.ml
+++ b/xPath.ml
@@ -190,14 +190,19 @@ module Functions = struct
   type value = [ `NodeSet of Automaton.BST.t 
   | `Int of int | `String of string
   | `Bool of bool | `True | `False ]
+
   type expr = [ value | `Call of (string*(expr list))
-  | `Auto of Automaton.t ]
+  | `Auto of Automaton.t | `Contains of expr list ]
 
 
   let count = function [`NodeSet(s) ] -> `Int(Automaton.BST.cardinal s)
     | _ -> failwith "count"
 	
-
+  let contains_old = function [`NodeSet(s) ; `String(str) ] ->
+    `Bool(Automaton.BST.exists (fun tree -> Tree.Binary.contains_old tree str
+			       ) s)
+    | _ -> failwith "contains_old"
+ 
   let equal = function [ `Int i; `Int j ] -> `Bool (i == j)
     |_ -> failwith "equal"
 
@@ -205,22 +210,36 @@ module Functions = struct
 
     ("count",count);
     ("equal",equal);
+    ("contains_old",contains_old);
 ]
 
   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.dump Format.err_formatter a;
-				  Tree.Binary.print_xml_fast stderr tree;
-				  Printf.eprintf "\n=======================\n%!";
-				  Automaton.TopDown.run a tree);
-			  Printf.eprintf "Results : %i\n%!" 
-			    (Automaton.BST.cardinal a.Automaton.result);
-			  Automaton.BST.iter (fun t -> Tree.Binary.print_xml_fast stderr t;
-						Printf.eprintf "^^^^^^^^^^^^^^^^^^^^^^^^\n%!") 
-			  a.Automaton.result;
-			  a.Automaton.result)
+    | `Auto(a) -> `NodeSet(ignore (Automaton.BottomUp.accept a tree);
+			   a.Automaton.result)
+    | `Contains(args) ->
+	begin
+	  match args with
+	      [ `Auto(a); `String(s) ] ->
+		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"
+	end
     | #value as x  -> x
 	
   let truth_value = 
@@ -295,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
@@ -356,8 +378,7 @@ module Compile = struct
       | Expr e -> match compile_expr e with
 	  | `True -> `Label (TagSet.Xml.any)
 	  | `False -> `Label (TagSet.Xml.empty)
-	  | e -> `Fun (fun t -> let r = Functions.truth_value (Functions.eval_expr t e) 
-		      in Printf.eprintf "Truth value is %b\n%!" r;r)
+	  | e -> `Fun (fun t -> Functions.truth_value (Functions.eval_expr t e))
 
     in match pred_rec p with
 	`Fun f -> mk_pred_trs f tkeep tchange
@@ -369,6 +390,7 @@ module Compile = struct
       | Path p -> `Auto(compile p)
       | Int i -> `Int i
       | String s -> `String s
+      | Function ("contains",elist) ->`Contains(List.map compile_expr elist)
       | Function (f,elist) -> `Call(f,List.map compile_expr elist) 
 	  
   and cup a b = match a,b with