src/table.ml

   1
   2 type query_tree_desc = Binop of op * query_tree * query_tree
   3                        | Axis of Xpath.Ast.axis * query_tree
   4                        | Start
   5                        | Dom
   6                        | Tag of QNameSet.t * Tree.NodeKind.t
   7
   8 and op = Union | Inter | Diff
   9
  10 and query_tree = {
  11   mutable desc  : query_tree_desc;
  12   mutable id : int;
  13   mutable hash : int;
  14 }
  15
  16
  17 module QTree = struct
  18   type t = query_tree
  19   let rec equal q1 q2 =
  20     q1 == q2 ||
  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)
  24
  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
  28         | _,_ ->false
  29   and compare_axis a1 a2 =
  30     match a1,a2 with
  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
  37       | _,_ -> false
  38
  39   let rec hash q =
  40     if q.hash != -1 then q.hash
  41     else match q.desc with
  42         Dom -> 1
  43       | Start -> 3
  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
  47
  48 end
  49
  50
  51 module QTreeHash = Hashtbl.Make(QTree)
  52
  53 let compare_node tree a b =
  54   compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b )
  55
  56 let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2)
  57
  58
  59 let rec union_list t l1 l2 =
  60   match l1,l2 with
  61     | [],l2 -> l2
  62     | l1, [] -> l1
  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)
  66
  67 let rec merge_list t l1 l2 =
  68   match l1,l2 with
  69     | [],l2 -> l2
  70     | l1,[] -> l1
  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)
  74
  75 let rec inter_list t l1 l2 =
  76   match l1,l2 with
  77     | [],l2 -> []
  78     | l1, [] -> []
  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)
  82
  83 let rec diff_list t l1 l2 =
  84   match l1,l2 with
  85     | [],l2 -> []
  86     | l1, [] -> l1
  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
  90
  91 let print_node_list tree l =
  92   List.iter (fun node ->
  93     Naive_tree.print_xml stdout tree node;
  94     print_newline()
  95   ) l
  96
  97 let rec print_query_tree fmt q =
  98   match q.desc with
  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
 102     | Axis (a,q) ->
 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)"
 106       print_binop  op
 107       print_query_tree  q1
 108       print_query_tree  q2
 109
 110 and print_binop fmt o =
 111   match o with
 112     | Union -> Format.fprintf fmt "Union"
 113     | Inter -> Format.fprintf fmt "Inter"
 114     | Diff -> Format.fprintf fmt "Diff"
 115
 116
 117 let rec compare_node_list tree l1 l2 =
 118   match l1,l2 with
 119       [],[] -> 0
 120     | _,[] -> 1
 121     | [],_ -> -1
 122     | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
 123                          if b=0 then compare_node_list tree ll1 ll2
 124                          else b
 125
 126
 127
 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;
 132   v
 133
 134 let decode_bit tree v =
 135   let l = ref [] in
 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
 139       l := n::!l
 140   done;
 141   List.rev !l
 142
 143 let get_list_ordred tree ll =
 144   let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
 145   List.rev l1
 146
 147 let get_descendant tree v =
 148   let rec aux n acc =
 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
 155          aux n2 acc1
 156   in
 157   let v0 = Bitvector.create (Naive_tree.size tree) in
 158  (* let v = bitvector_of_nodes tree ln in*)
 159   for i = 0 to (Bitvector.length v)-1 do
 160     if Bitvector.get v i then
 161       let n = Naive_tree.by_preorder tree i in
 162       let n1 = Naive_tree.first_child tree n in
 163       let _ = aux n1 v0 in ();
 164   done;
 165   v0
 166
 167 let get_child tree v =
 168   let rec aux n acc =
 169     if n == Naive_tree.nil then acc
 170     else
 171       let n1 = Naive_tree.next_sibling tree n in
 172       Bitvector.set acc (Naive_tree.preorder tree n) true;
 173       aux n1 acc
 174   in
 175   let v0 = Bitvector.create (Naive_tree.size tree) in
 176   (*let v = bitvector_of_nodes tree ln in*)
 177   for i = 0 to (Bitvector.length v)-1 do
 178     if Bitvector.get v i then
 179       let n = Naive_tree.by_preorder tree i in
 180       let n1 = Naive_tree.first_child tree n in
 181       let _ = aux n1 v0 in ();
 182   done;
 183   v0
 184
 185
 186 let get_followingSibling tree v =
 187   let rec aux n acc =
 188     let n1 = Naive_tree.next_sibling tree n in
 189     if n1 == Naive_tree.nil then acc
 190     else begin
 191       Bitvector.set acc (Naive_tree.preorder tree n1) true;
 192       aux n1 acc end
 193   in
 194   let v0 = Bitvector.create (Naive_tree.size tree) in
 195  (* let v = bitvector_of_nodes tree ln in*)
 196   for i = 0 to (Bitvector.length v)-1 do
 197     if Bitvector.get v i then
 198       let n = Naive_tree.by_preorder tree i in
 199       let _ = aux n v0 in ();
 200   done;
 201   v0
 202
 203 let rec get_firstBling tree n pred =
 204   if n== Naive_tree.nil then pred
 205   else get_firstBling tree (Naive_tree.prev_sibling tree n) n
 206
 207 let get_parent tree v =
 208   let v0 = Bitvector.create (Naive_tree.size tree) in
 209  (* let v = bitvector_of_nodes tree ln in*)
 210   for i = 0 to (Bitvector.length v)-1 do
 211     if Bitvector.get v i then
 212       let n = Naive_tree.by_preorder tree i in
 213       let n1 = get_firstBling tree n Naive_tree.nil in
 214       let n2 = Naive_tree.parent_of_first tree n1 in
 215       if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
 216                                          Bitvector.set v0 j true
 217       end
 218   done;
 219   v0
 220
 221 let get_ancestor tree v =
 222   let v0 = Bitvector.create (Naive_tree.size tree) in
 223  (* let v = bitvector_of_nodes tree ln in  *)
 224
 225   for i = (Bitvector.length v)-1 downto 0 do
 226     if Bitvector.get v i then
 227       let n = Naive_tree.by_preorder tree i in
 228       let n0 = ref n in
 229       while !n0 != Naive_tree.nil do
 230         let n1 = get_firstBling tree !n0 Naive_tree.nil in
 231         let n2 = Naive_tree.parent_of_first tree n1 in
 232         n0 := n2;
 233         if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
 234                                            Bitvector.set v0 j true;
 235                                            Bitvector.set v j true;
 236         end
 237       done;
 238   done;
 239   v0
 240
 241 let get_preSibling tree v =
 242   let rec aux n acc =
 243     let n1 = Naive_tree.prev_sibling tree n in
 244     if n1 == Naive_tree.nil then acc
 245     else begin
 246       Bitvector.set acc (Naive_tree.preorder tree n1) true;
 247       aux n1 acc end
 248   in
 249   let v0 = Bitvector.create (Naive_tree.size tree) in
 250  (* let v = bitvector_of_nodes tree ln in*)
 251   for i = 0 to (Bitvector.length v)-1 do
 252     if Bitvector.get v i then
 253       let n = Naive_tree.by_preorder tree i in
 254       let _ = aux n v0 in ()
 255   done;
 256   v0
 257
 258
 259
 260
 261 let rec eval_axis tree v a =
 262   let open Xpath.Ast in
 263         match a with
 264             Self -> v
 265
 266           | Attribute -> get_child tree v
 267
 268           | Child -> get_child tree v
 269
 270           | Descendant c -> let v2 = get_descendant tree v in
 271                             if not c then v2
 272                             else Bitvector.union v2 v
 273
 274
 275           | FollowingSibling -> get_followingSibling tree v
 276
 277           | Parent -> get_parent tree v
 278
 279           | Ancestor b -> let v2 = get_ancestor tree v in
 280                           if not b then v2
 281                           else Bitvector.union v2 v
 282
 283
 284           | PrecedingSibling -> get_preSibling tree v
 285
 286           | Preceding -> let v2 = eval_axis tree v (Ancestor true) in
 287                          let v3 = eval_axis tree v2 PrecedingSibling in
 288                          eval_axis tree v3 (Descendant true)
 289
 290
 291           | Following -> let v2 = eval_axis tree v (Ancestor true) in
 292                          let v3 = eval_axis tree v2 FollowingSibling in
 293                          eval_axis tree v3 (Descendant true)
 294
 295
 296
 297
 298
 299
 300
 301