src/table.ml

   1
   2 let node_compteur = ref 0
   3
   4 type query_tree_desc = Binop of op * query_tree * query_tree
   5                        | Axis of Xpath.Ast.axis * query_tree
   6                        | Start
   7                        | Dom
   8                        | Tag of QNameSet.t * Tree.NodeKind.t
   9
  10 and op = Union | Inter | Diff
  11
  12 and query_tree = {
  13   mutable desc  : query_tree_desc;
  14   mutable id : int;
  15   mutable hash : int;
  16 }
  17
  18
  19 module QTree = struct
  20   type t = query_tree
  21   let rec equal q1 q2 =
  22     q1 == q2 ||
  23       (q1.id == q2.id && q1.id != -1) ||
  24       match q1.desc, q2.desc with
  25         | Binop(op1,qt1,qt2),Binop(op2,qt3,qt4)-> op1==op2&& (equal qt1 qt3 && equal qt2 qt4)
  26
  27         | Axis(a1,qt1),Axis(a2,qt2) -> compare_axis a1 a2 && equal qt1 qt2
  28         | Tag(t1,k1),Tag(t2,k2) -> t1==t2&& k1==k2
  29         | Dom,Dom | Start,Start -> true
  30         | _,_ ->false
  31   and compare_axis a1 a2 =
  32     match a1,a2 with
  33         Self ,Self | Attribute, Attribute | Child , Child | Parent , Parent
  34       | FollowingSibling , FollowingSibling
  35       | PrecedingSibling , PrecedingSibling
  36       | Preceding , Preceding | Following , Following -> true
  37       | Descendant b1, Descendant b2 -> b1==b2
  38       | Ancestor b1, Ancestor b2 -> b1==b2
  39       | _,_ -> false
  40
  41   let rec hash q =
  42     if q.hash != -1 then q.hash
  43     else match q.desc with
  44         Dom -> 1
  45       | Start -> 3
  46       | Tag(s,_) -> 5 + 17*QNameSet.hash s
  47       | Axis(a,q) -> 7 + 17 * Hashtbl.hash a + 23* hash q
  48       | Binop(op,q1,q2) -> 11 + 17* Hashtbl.hash op + 23* hash q1 + 27* hash q2
  49
  50 end
  51
  52
  53 module QTreeHash = Hashtbl.Make(QTree)
  54
  55 let compare_node tree a b =
  56   compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b )
  57
  58 let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2)
  59
  60
  61 let rec union_list t l1 l2 =
  62   match l1,l2 with
  63     | [],l2 -> l2
  64     | l1, [] -> l1
  65     | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h2 :: (union_list t l1 ll2)
  66       else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
  67       else h1 ::(union_list t ll1 ll2)
  68
  69 let rec merge_list t l1 l2 =
  70   match l1,l2 with
  71     | [],l2 -> l2
  72     | l1,[] -> l1
  73     | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
  74       else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
  75       else h1::(merge_list t ll1 ll2)
  76
  77 let rec inter_list t l1 l2 =
  78   match l1,l2 with
  79     | [],l2 -> []
  80     | l1, [] -> []
  81     | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2
  82       else if (comp_node t h2 h1) then inter_list t l1 ll2
  83       else h1 :: (inter_list t ll1 ll2)
  84
  85 let rec diff_list t l1 l2 =
  86   match l1,l2 with
  87     | [],l2 -> []
  88     | l1, [] -> l1
  89     | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2)
  90       else if (comp_node t h2 h1)  then h2 :: (diff_list t l1 ll2)
  91       else diff_list t ll1 ll2
  92
  93 let print_node_list tree l =
  94   List.iter (fun node ->
  95     Naive_tree.print_xml stdout tree node;
  96     print_newline()
  97   ) l
  98
  99 let rec print_query_tree fmt q =
 100   match q.desc with
 101       Dom -> Format.fprintf fmt "Dom"
 102     | Start -> Format.fprintf fmt "Start"
 103     | Tag (t,k) -> Format.fprintf fmt "Tag(%a, %a)" QNameSet.print t Tree.NodeKind.print k
 104     | Axis (a,q) ->
 105       Format.fprintf fmt "%a(%a)" Xpath.Ast.print_axis a print_query_tree q
 106     | Binop (op,q1,q2) ->
 107       Format.fprintf fmt "%a(%a, %a)"
 108       print_binop  op
 109       print_query_tree  q1
 110       print_query_tree  q2
 111
 112 and print_binop fmt o =
 113   match o with
 114     | Union -> Format.fprintf fmt "Union"
 115     | Inter -> Format.fprintf fmt "Inter"
 116     | Diff -> Format.fprintf fmt "Diff"
 117
 118
 119 let rec compare_node_list tree l1 l2 =
 120   match l1,l2 with
 121       [],[] -> 0
 122     | _,[] -> 1
 123     | [],_ -> -1
 124     | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
 125                          if b=0 then compare_node_list tree ll1 ll2
 126                          else b
 127
 128
 129
 130 let bitvector_of_nodes tree l =
 131   let v = Bitvector.create (Naive_tree.size tree) in
 132   List.iter(fun n -> let j = Naive_tree.preorder tree n in
 133                      Bitvector.set v j true ) l;
 134   v
 135
 136 let decode_bit tree v =
 137   let l = ref [] in
 138   for i = 0 to (Bitvector.length v) - 1 do
 139     if Bitvector.get v i then
 140       let n = Naive_tree.by_preorder tree i in
 141       l := n::!l
 142   done;
 143   List.rev !l
 144
 145 let get_list_ordred tree ll =
 146   let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
 147   List.rev l1
 148
 149 let get_descendant tree c v =
 150   let rec aux n acc =
 151     if n == Naive_tree.nil then acc
 152     else let n1 = Naive_tree.first_child tree n in
 153          let j = Naive_tree.preorder tree n in
 154          Bitvector.set acc j true;
 155          incr node_compteur;
 156          let acc1 = aux n1 acc in
 157          let n2 = Naive_tree.next_sibling tree n in
 158          aux n2 acc1
 159   in
 160   let v0 = Bitvector.create (Naive_tree.size tree) in
 161   if c then begin
 162     for i = 0 to (Bitvector.length v)-1 do
 163       if Bitvector.get v i then
 164         let n = Naive_tree.by_preorder tree i in
 165         let n1 = Naive_tree.first_child tree n in
 166         let _ = aux n1 v0 in
 167         Bitvector.set v0 i true;
 168         incr node_compteur
 169     done; end
 170   else
 171     for i = 0 to (Bitvector.length v)-1 do
 172       if Bitvector.get v i then
 173         let n = Naive_tree.by_preorder tree i in
 174         let n1 = Naive_tree.first_child tree n in
 175         let _ = aux n1 v0 in ()
 176     done;
 177   v0
 178
 179 let get_child tree v =
 180   let rec aux n acc =
 181     if n == Naive_tree.nil then acc
 182     else
 183       let n1 = Naive_tree.next_sibling tree n in
 184       Bitvector.set acc (Naive_tree.preorder tree n) true;
 185       incr node_compteur;
 186       aux n1 acc
 187   in
 188   let v0 = Bitvector.create (Naive_tree.size tree) in
 189   for i = 0 to (Bitvector.length v)-1 do
 190     if Bitvector.get v i then
 191       let n = Naive_tree.by_preorder tree i in
 192       let n1 = Naive_tree.first_child tree n in
 193       let _ = aux n1 v0 in ();
 194   done;
 195   v0
 196
 197
 198 let get_followingSibling tree v =
 199   let rec aux n acc =
 200     let n1 = Naive_tree.next_sibling tree n in
 201     if n1 == Naive_tree.nil then acc
 202     else begin
 203       Bitvector.set acc (Naive_tree.preorder tree n1) true;
 204       incr node_compteur;
 205       aux n1 acc end
 206   in
 207   let v0 = Bitvector.create (Naive_tree.size tree) in
 208   for i = 0 to (Bitvector.length v)-1 do
 209     if Bitvector.get v i then
 210       let n = Naive_tree.by_preorder tree i in
 211       let _ = aux n v0 in ();
 212   done;
 213   v0
 214
 215 let rec get_firstBling tree n pred =
 216   if n== Naive_tree.nil then pred
 217   else get_firstBling tree (Naive_tree.prev_sibling tree n) n
 218
 219 let get_parent tree v =
 220   let v0 = Bitvector.create (Naive_tree.size tree) in
 221   for i = 0 to (Bitvector.length v)-1 do
 222     if Bitvector.get v i then
 223       let n = Naive_tree.by_preorder tree i in
 224       let n1 = get_firstBling tree n Naive_tree.nil in
 225       let n2 = Naive_tree.parent_of_first tree n1 in
 226       if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
 227                                          Bitvector.set v0 j true;
 228                                          incr node_compteur
 229       end
 230   done;
 231   v0
 232
 233 let get_ancestor tree b v =
 234   let v0 = Bitvector.create (Naive_tree.size tree) in
 235   if b then
 236     begin
 237       for i = (Bitvector.length v)-1 downto 0 do
 238         if Bitvector.get v i then
 239           begin
 240             Bitvector.set v0 i true;
 241             incr node_compteur;
 242             let n = Naive_tree.by_preorder tree i in
 243             let n0 = ref n in
 244             while !n0 != Naive_tree.nil do
 245               let n1 = get_firstBling tree !n0 Naive_tree.nil in
 246               let n2 = Naive_tree.parent_of_first tree n1 in
 247               n0 := n2;
 248               if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
 249                                                  Bitvector.set v0 j true;
 250                                                  Bitvector.set v j true;
 251                                                  node_compteur := !node_compteur + 2;
 252               end
 253             done;
 254           end
 255       done;
 256     end
 257   else
 258     for i = (Bitvector.length v)-1 downto 0 do
 259       if Bitvector.get v i then
 260         begin
 261           let n = Naive_tree.by_preorder tree i in
 262           let n0 = ref n in
 263           while !n0 != Naive_tree.nil do
 264             let n1 = get_firstBling tree !n0 Naive_tree.nil in
 265             let n2 = Naive_tree.parent_of_first tree n1 in
 266             n0 := n2;
 267             if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
 268                                                Bitvector.set v0 j true;
 269                                                Bitvector.set v j true;
 270                                                node_compteur := !node_compteur + 2;
 271             end
 272           done;
 273         end
 274     done;
 275   v0
 276
 277 let get_preSibling tree v =
 278   let rec aux n acc =
 279     let n1 = Naive_tree.prev_sibling tree n in
 280     if n1 == Naive_tree.nil then acc
 281     else begin
 282       Bitvector.set acc (Naive_tree.preorder tree n1) true;
 283       incr node_compteur;
 284       aux n1 acc end
 285   in
 286   let v0 = Bitvector.create (Naive_tree.size tree) in
 287   for i = 0 to (Bitvector.length v)-1 do
 288     if Bitvector.get v i then
 289       let n = Naive_tree.by_preorder tree i in
 290       let _ = aux n v0 in ()
 291   done;
 292   v0
 293
 294
 295
 296
 297 let rec eval_axis tree v a =
 298   let open Xpath.Ast in
 299         match a with
 300             Self -> v
 301
 302           | Attribute -> get_child tree v
 303
 304           | Child -> get_child tree v
 305
 306           | Descendant c ->  get_descendant tree c v
 307
 308
 309
 310           | FollowingSibling -> get_followingSibling tree v
 311
 312           | Parent -> get_parent tree v
 313
 314           | Ancestor b ->  get_ancestor tree b v
 315
 316
 317
 318           | PrecedingSibling -> get_preSibling tree v
 319
 320           | Preceding -> let v2 = eval_axis tree v (Ancestor true) in
 321                          let v3 = eval_axis tree v2 PrecedingSibling in
 322                          eval_axis tree v3 (Descendant true)
 323
 324
 325           | Following -> let v2 = eval_axis tree v (Ancestor true) in
 326                          let v3 = eval_axis tree v2 FollowingSibling in
 327                          eval_axis tree v3 (Descendant true)
 328
 329
 330
 331
 332
 333
 334
 335