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 inter_list t l1 l2 =
71 | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2
72 else if (comp_node t h2 h1) then inter_list t l1 ll2
73 else h1 :: (inter_list t ll1 ll2)
75 let rec diff_list t l1 l2 =
79 | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2)
80 else if (comp_node t h2 h1) then h2 :: (diff_list t l1 ll2)
81 else diff_list t ll1 ll2
83 let print_node_list tree l =
84 List.iter (fun node ->
85 Naive_tree.print_xml stdout tree node;
89 let rec print_query_tree fmt q =
91 Dom -> Format.fprintf fmt "Dom"
92 | Start -> Format.fprintf fmt "Start"
93 | Tag (t,k) -> Format.fprintf fmt "Tag(%a, %a)" QNameSet.print t Tree.NodeKind.print k
95 Format.fprintf fmt "%a(%a)" Xpath.Ast.print_axis a print_query_tree q
97 Format.fprintf fmt "%a(%a, %a)"
102 and print_binop fmt o =
104 | Union -> Format.fprintf fmt "Union"
105 | Inter -> Format.fprintf fmt "Inter"
106 | Diff -> Format.fprintf fmt "Diff"
109 let rec compare_node_list tree l1 l2 =
114 | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
115 if b=0 then compare_node_list tree ll1 ll2
118 let get_descendant tree ln =
120 if n == Naive_tree.nil then acc
121 else let n1 = Naive_tree.first_child tree n in
122 let acc1 = aux n1 (n::acc) in
123 let n2 = Naive_tree.next_sibling tree n in
124 let acc2 = aux n2 acc1 in
127 let l = List.fold_left (fun acc n -> if List.mem n acc then acc
128 else let n1 = Naive_tree.first_child tree n in
133 let get_child tree ln =
135 if n == Naive_tree.nil then acc
137 let n1 = Naive_tree.next_sibling tree n in
140 let ll = List.map (fun n->
141 let n1 = Naive_tree.first_child tree n in
142 let res = aux n1 [] in
145 List.fold_left (fun acc l -> union_list tree acc l) [] ll
148 let get_followingSibling tree ln =
150 let n1 = Naive_tree.next_sibling tree n in
151 if n1 == Naive_tree.nil then acc
152 else aux n1 (n1::acc)
154 let ll = List.map (fun n -> let res = aux n [] in
156 List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll
159 let rec get_firstBling tree n pred =
160 if n== Naive_tree.nil then pred
161 else get_firstBling tree (Naive_tree.prev_sibling tree n) n
163 let get_parent tree ln =
164 let l = List.fold_left (fun acc n ->
165 let n1 = get_firstBling tree n Naive_tree.nil in
166 let n2 = Naive_tree.parent_of_first tree n1 in
167 if n2 == Naive_tree.nil or List.mem n2 acc then acc
168 else union_list tree [n2] acc
175 let get_ancestor tree ln =
176 let rec aux tree l1 acc =
179 | _ -> let ll1 = get_parent tree l1 in
180 let acc1 = union_list tree acc ll1 in
183 let l = aux tree ln [] in
186 let get_preSibling tree ln =
188 let n1 = Naive_tree.prev_sibling tree n in
189 if n1 == Naive_tree.nil then acc
190 else aux n1 (n1::acc)
192 let ll = List.map (fun n -> aux n [] ) ln in
193 List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll
197 let rec eval_axis tree ls a =
198 let open Xpath.Ast in
202 | Attribute -> get_child tree ls
204 | Child -> get_child tree ls
206 | Descendant c -> let ls2 = get_descendant tree ls in
209 else union_list tree ls2 ls
213 | FollowingSibling -> get_followingSibling tree ls
215 | Parent -> get_parent tree ls
218 let ls3 = get_ancestor tree ls in
221 else union_list tree ls3 ls
225 | PrecedingSibling -> get_preSibling tree ls
227 | Preceding -> let ls2 = eval_axis tree ls (Ancestor true) in
228 let ls3 = eval_axis tree ls2 PrecedingSibling in
229 let lp = eval_axis tree ls3 (Descendant true) in
232 | Following -> let ls2 = eval_axis tree ls (Ancestor true) in
233 let ls3 = eval_axis tree ls2 FollowingSibling in
234 let lf = eval_axis tree ls3 (Descendant true) in