3 let query_tree_size = ref 0
5 let table_qtree = QTreeHash.create 97
8 let element_by_tag tree tagset kind = let v = Bitvector.create (Naive_tree.size tree) in
9 for i=0 to (Bitvector.length v)-1 do
10 let c = Naive_tree.by_preorder tree i in
11 if (Tree.NodeKind.is_a (Naive_tree.kind tree c) kind &&
12 QNameSet.mem (Naive_tree.tag tree c) tagset )
13 then Bitvector.set v i true
18 let mk_node q = {desc = q; id = -1; hash = -1}
20 let rec compile_single_path p =
23 | Absolute p | Relative p -> compile_step_list (List.rev p)
25 and compile_step_list p =
28 | (a,(test,kind),el) :: r ->
29 let qtree = compile_step_list r in
30 let res = mk_node ( Binop ( Inter,mk_node( Axis (a,qtree)),mk_node (Tag (test,kind) )) ) in
31 List.fold_left (fun acc e ->
32 mk_node (Binop(Inter, acc, compile_expr e))) res el
34 and compile_expr (e : Xpath.Ast.expr ) = match e with
35 | Fun_call (f, [ e0 ]) when (QName.to_string f) = "not" ->
36 let qtree = compile_expr e0 in
37 mk_node (Binop (Diff , mk_node (Dom), qtree))
39 | Binop (e1,op,e2) -> let qtree1 = compile_expr e1 in
40 let qtree2 = compile_expr e2 in
43 | Or -> mk_node (Binop (Union , qtree1,qtree2))
44 | And -> mk_node (Binop (Inter ,qtree1,qtree2))
45 | _ -> failwith "Unknown operator"
47 | Path p -> compile_path_rev p
48 | _ -> failwith "Unknown expression"
50 and compile_path_rev p =
53 | [p] -> compile_single_path_rev p
54 | p::r -> List.fold_left (fun acc p -> mk_node (Binop (Union , acc, compile_single_path_rev p)) ) (compile_single_path_rev p) r
56 and compile_single_path_rev p =
58 | Absolute p | Relative p -> compile_step_list_rev p
60 and compile_step_list_rev p = match p with
62 | (a,(test,kind),el) :: r ->
63 let qtree = compile_step_list_rev r in
64 let res = mk_node (Binop (Inter , qtree,mk_node (Tag(test,kind)))) in
65 let qtree2 = List.fold_left (fun acc e ->
66 mk_node (Binop(Inter, acc, compile_expr e))) res el in
67 let a_rev = axis_rev a in
68 mk_node (Axis (a_rev , qtree2))
78 if not b then (Ancestor false)
79 else (Ancestor true) (* true = descendant-or-self, false = descendant *)
80 | FollowingSibling -> PrecedingSibling
83 if not b then (Descendant false)
84 else (Descendant true) (* true = ancestor-or-self, false = ancestor *)
85 | PrecedingSibling -> FollowingSibling
86 | Preceding -> Following
87 | Following -> Preceding
90 let compile_xpath p = match p with
92 | [p] -> compile_single_path p
93 | p::r -> List.fold_left (fun acc p -> mk_node (Binop (Union , acc, compile_single_path p) )) (compile_single_path p) r
98 let do_debug = ref false
101 if !do_debug then begin
102 Format.fprintf Format.std_formatter "Evaluation de: ";
103 print_query_tree Format.std_formatter q;
104 Format.fprintf Format.std_formatter "\nResultat: %i\n"
106 Format.pp_print_flush Format.std_formatter ();
107 print_node_list tree l;
109 (fun n -> Format.fprintf Format.std_formatter "%i, " (Naive_tree.preorder tree n)) l;*)
110 Format.fprintf Format.std_formatter "\n----------------\n";
111 Format.pp_print_flush Format.std_formatter ();
115 let mini_table = QTreeHash.create 17
117 let rec minimize_qtree q =
121 QTreeHash.find mini_table q
125 (Start | Dom | Tag _) as d -> d
126 | Binop(op,q1,q2) -> let mq1 = minimize_qtree q1 in
127 let mq2 = minimize_qtree q2 in
129 | Axis(a,q1) -> let mq1 = minimize_qtree q1 in
133 q.hash <- QTree.hash q;
136 QTreeHash.add mini_table q q;
141 let rec eval_qtree tree start q =
145 QTreeHash.find table_qtree q
150 | Dom -> Bitvector.create ~init:true (Naive_tree.size tree)
151 | Tag (t,k) -> element_by_tag tree t k
152 | Axis (a,q1) -> let v = eval_qtree tree start q1 in
154 | Binop (op,q1,q2)-> begin
155 let v1 = eval_qtree tree start q1 in
156 let v2 = eval_qtree tree start q2 in
157 Table.node_compteur := !Table.node_compteur + 2*Bitvector.length v1;
159 | Union -> Bitvector.union v1 v2
160 | Inter -> Bitvector.inter v1 v2
161 | Diff -> Bitvector.diff v1 v2
164 QTreeHash.add table_qtree q res;
168 (* debug tree q resultat;*)
169 incr query_tree_size;