2 type query_tree_desc = Binop of op * query_tree * query_tree
3 | Axis of Xpath.Ast.axis * query_tree
6 | Tag of QNameSet.t * Tree.NodeKind.t
8 and op = Union | Inter | Diff
11 mutable desc : query_tree_desc;
21 (q1.id == q2.id && q1.id != -1) ||
22 match q1.desc, q2.desc with
23 | Binop(op1,qt1,qt2),Binop(op2,qt3,qt4)-> op1==op2&& (equal qt1 qt3 && equal qt2 qt4)
25 | Axis(a1,qt1),Axis(a2,qt2) -> compare_axis a1 a2 && equal qt1 qt2
26 | Tag(t1,k1),Tag(t2,k2) -> t1==t2&& k1==k2
27 | Dom,Dom | Start,Start -> true
29 and compare_axis a1 a2 =
31 Self ,Self | Attribute, Attribute | Child , Child | Parent , Parent
32 | FollowingSibling , FollowingSibling
33 | PrecedingSibling , PrecedingSibling
34 | Preceding , Preceding | Following , Following -> true
35 | Descendant b1, Descendant b2 -> b1==b2
36 | Ancestor b1, Ancestor b2 -> b1==b2
40 if q.hash != -1 then q.hash
41 else match q.desc with
44 | Tag(s,_) -> 5 + 17*QNameSet.hash s
45 | Axis(a,q) -> 7 + 17 * Hashtbl.hash a + 23* hash q
46 | Binop(op,q1,q2) -> 11 + 17* Hashtbl.hash op + 23* hash q1 + 27* hash q2
51 module QTreeHash = Hashtbl.Make(QTree)
53 let compare_node tree a b =
54 compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b )
56 let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2)
59 let rec union_list t l1 l2 =
63 | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h2 :: (union_list t l1 ll2)
64 else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
65 else h1 ::(union_list t ll1 ll2)
67 let rec merge_list t l1 l2 =
71 | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
72 else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
73 else h1::(merge_list t ll1 ll2)
75 let rec inter_list t l1 l2 =
79 | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2
80 else if (comp_node t h2 h1) then inter_list t l1 ll2
81 else h1 :: (inter_list t ll1 ll2)
83 let rec diff_list t l1 l2 =
87 | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2)
88 else if (comp_node t h2 h1) then h2 :: (diff_list t l1 ll2)
89 else diff_list t ll1 ll2
91 let print_node_list tree l =
92 List.iter (fun node ->
93 Naive_tree.print_xml stdout tree node;
97 let rec print_query_tree fmt q =
99 Dom -> Format.fprintf fmt "Dom"
100 | Start -> Format.fprintf fmt "Start"
101 | Tag (t,k) -> Format.fprintf fmt "Tag(%a, %a)" QNameSet.print t Tree.NodeKind.print k
103 Format.fprintf fmt "%a(%a)" Xpath.Ast.print_axis a print_query_tree q
104 | Binop (op,q1,q2) ->
105 Format.fprintf fmt "%a(%a, %a)"
110 and print_binop fmt o =
112 | Union -> Format.fprintf fmt "Union"
113 | Inter -> Format.fprintf fmt "Inter"
114 | Diff -> Format.fprintf fmt "Diff"
117 let rec compare_node_list tree l1 l2 =
122 | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
123 if b=0 then compare_node_list tree ll1 ll2
128 let bitvector_of_nodes tree l =
129 let v = Bitvector.create (Naive_tree.size tree) in
130 List.iter(fun n -> let j = Naive_tree.preorder tree n in
131 Bitvector.set v j true ) l;
134 let decode_bit tree v =
136 for i = 0 to (Bitvector.length v) - 1 do
137 if Bitvector.get v i then
138 let n = Naive_tree.by_preorder tree i in
143 let get_list_ordred tree ll =
144 let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
147 let get_descendant tree c v =
149 if n == Naive_tree.nil then acc
150 else let n1 = Naive_tree.first_child tree n in
151 let j = Naive_tree.preorder tree n in
152 Bitvector.set acc j true;
153 let acc1 = aux n1 acc in
154 let n2 = Naive_tree.next_sibling tree n in
157 let v0 = Bitvector.create (Naive_tree.size tree) in
158 (* let v = bitvector_of_nodes tree ln in*)
160 for i = 0 to (Bitvector.length v)-1 do
161 if Bitvector.get v i then
162 let n = Naive_tree.by_preorder tree i in
163 let n1 = Naive_tree.first_child tree n in
165 Bitvector.set v0 i true
168 for i = 0 to (Bitvector.length v)-1 do
169 if Bitvector.get v i then
170 let n = Naive_tree.by_preorder tree i in
171 let n1 = Naive_tree.first_child tree n in
172 let _ = aux n1 v0 in ()
176 let get_child tree v =
178 if n == Naive_tree.nil then acc
180 let n1 = Naive_tree.next_sibling tree n in
181 Bitvector.set acc (Naive_tree.preorder tree n) true;
184 let v0 = Bitvector.create (Naive_tree.size tree) in
185 (*let v = bitvector_of_nodes tree ln in*)
186 for i = 0 to (Bitvector.length v)-1 do
187 if Bitvector.get v i then
188 let n = Naive_tree.by_preorder tree i in
189 let n1 = Naive_tree.first_child tree n in
190 let _ = aux n1 v0 in ();
195 let get_followingSibling tree v =
197 let n1 = Naive_tree.next_sibling tree n in
198 if n1 == Naive_tree.nil then acc
200 Bitvector.set acc (Naive_tree.preorder tree n1) true;
203 let v0 = Bitvector.create (Naive_tree.size tree) in
204 (* let v = bitvector_of_nodes tree ln in*)
205 for i = 0 to (Bitvector.length v)-1 do
206 if Bitvector.get v i then
207 let n = Naive_tree.by_preorder tree i in
208 let _ = aux n v0 in ();
212 let rec get_firstBling tree n pred =
213 if n== Naive_tree.nil then pred
214 else get_firstBling tree (Naive_tree.prev_sibling tree n) n
216 let get_parent tree v =
217 let v0 = Bitvector.create (Naive_tree.size tree) in
218 (* let v = bitvector_of_nodes tree ln in*)
219 for i = 0 to (Bitvector.length v)-1 do
220 if Bitvector.get v i then
221 let n = Naive_tree.by_preorder tree i in
222 let n1 = get_firstBling tree n Naive_tree.nil in
223 let n2 = Naive_tree.parent_of_first tree n1 in
224 if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
225 Bitvector.set v0 j true
230 let get_ancestor tree b v =
231 let v0 = Bitvector.create (Naive_tree.size tree) in
232 (* let v = bitvector_of_nodes tree ln in *)
235 for i = (Bitvector.length v)-1 downto 0 do
236 if Bitvector.get v i then
238 Bitvector.set v0 i true;
239 let n = Naive_tree.by_preorder tree i in
241 while !n0 != Naive_tree.nil do
242 let n1 = get_firstBling tree !n0 Naive_tree.nil in
243 let n2 = Naive_tree.parent_of_first tree n1 in
245 if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
246 Bitvector.set v0 j true;
247 Bitvector.set v j true;
254 for i = (Bitvector.length v)-1 downto 0 do
255 if Bitvector.get v i then
257 let n = Naive_tree.by_preorder tree i in
259 while !n0 != Naive_tree.nil do
260 let n1 = get_firstBling tree !n0 Naive_tree.nil in
261 let n2 = Naive_tree.parent_of_first tree n1 in
263 if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
264 Bitvector.set v0 j true;
265 Bitvector.set v j true;
272 let get_preSibling tree v =
274 let n1 = Naive_tree.prev_sibling tree n in
275 if n1 == Naive_tree.nil then acc
277 Bitvector.set acc (Naive_tree.preorder tree n1) true;
280 let v0 = Bitvector.create (Naive_tree.size tree) in
281 (* let v = bitvector_of_nodes tree ln in*)
282 for i = 0 to (Bitvector.length v)-1 do
283 if Bitvector.get v i then
284 let n = Naive_tree.by_preorder tree i in
285 let _ = aux n v0 in ()
292 let rec eval_axis tree v a =
293 let open Xpath.Ast in
297 | Attribute -> get_child tree v
299 | Child -> get_child tree v
301 | Descendant c -> get_descendant tree c v
305 | FollowingSibling -> get_followingSibling tree v
307 | Parent -> get_parent tree v
309 | Ancestor b -> get_ancestor tree b v
313 | PrecedingSibling -> get_preSibling tree v
315 | Preceding -> let v2 = eval_axis tree v (Ancestor true) in
316 let v3 = eval_axis tree v2 PrecedingSibling in
317 eval_axis tree v3 (Descendant true)
320 | Following -> let v2 = eval_axis tree v (Ancestor true) in
321 let v3 = eval_axis tree v2 FollowingSibling in
322 eval_axis tree v3 (Descendant true)