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 inter_list t l1 l2 =
  68   match l1,l2 with
  69     | [],l2 -> []
  70     | l1, [] -> []
  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)
  74
  75 let rec diff_list t l1 l2 =
  76   match l1,l2 with
  77     | [],l2 -> []
  78     | l1, [] -> l1
  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
  82
  83 let print_node_list tree l =
  84   List.iter (fun node ->
  85     Naive_tree.print_xml stdout tree node;
  86     print_newline()
  87   ) l
  88
  89 let rec print_query_tree fmt q =
  90   match q.desc with
  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
  94     | Axis (a,q) ->
  95       Format.fprintf fmt "%a(%a)" Xpath.Ast.print_axis a print_query_tree q
  96     | Binop (op,q1,q2) ->
  97       Format.fprintf fmt "%a(%a, %a)"
  98       print_binop  op
  99       print_query_tree  q1
 100       print_query_tree  q2
 101
 102 and print_binop fmt o =
 103   match o with
 104     | Union -> Format.fprintf fmt "Union"
 105     | Inter -> Format.fprintf fmt "Inter"
 106     | Diff -> Format.fprintf fmt "Diff"
 107
 108
 109 let rec compare_node_list tree l1 l2 =
 110   match l1,l2 with
 111       [],[] -> 0
 112     | _,[] -> 1
 113     | [],_ -> -1
 114     | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
 115                          if b=0 then compare_node_list tree ll1 ll2
 116                          else b
 117
 118 let get_descendant tree ln =
 119   let rec aux n acc =
 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
 125          acc2
 126   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
 129          aux n1 acc) [] ln
 130   in
 131   List.rev l
 132
 133 let get_child tree ln =
 134   let rec aux n acc =
 135     if n == Naive_tree.nil then acc
 136     else
 137       let n1 = Naive_tree.next_sibling tree n in
 138       aux n1 (n::acc)
 139   in
 140   let ll = List.map (fun  n->
 141     let n1 = Naive_tree.first_child tree n in
 142     let res = aux n1 [] in
 143     List.rev res
 144   )  ln in
 145   List.fold_left (fun acc l -> union_list tree acc l) [] ll
 146
 147
 148 let get_followingSibling tree ln =
 149   let rec aux n acc =
 150     let n1 = Naive_tree.next_sibling tree n in
 151     if n1 == Naive_tree.nil then acc
 152     else aux n1 (n1::acc)
 153   in
 154   let ll = List.map (fun n -> let res = aux n [] in
 155                               List.rev res ) ln in
 156   List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll
 157
 158
 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
 162
 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
 169   ) [] ln
 170   in
 171   l
 172
 173
 174
 175 let get_ancestor tree ln =
 176   let rec aux tree l1 acc =
 177     match l1 with
 178         [] -> acc
 179       | _ -> let ll1 = get_parent tree l1 in
 180              let acc1 = union_list tree acc ll1 in
 181              aux tree ll1  acc1
 182   in
 183   let l = aux tree ln [] in
 184   l
 185
 186 let get_preSibling tree ln =
 187   let rec aux n acc =
 188     let n1 = Naive_tree.prev_sibling tree n in
 189     if n1 == Naive_tree.nil then acc
 190     else aux n1 (n1::acc)
 191   in
 192   let ll = List.map (fun n -> aux n [] ) ln in
 193   List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll
 194
 195
 196
 197 let rec eval_axis tree ls a =
 198   let open Xpath.Ast in
 199         match a with
 200             Self -> ls
 201
 202           | Attribute -> get_child tree ls
 203
 204           | Child -> get_child tree ls
 205
 206           | Descendant c -> let ls2 = get_descendant tree ls in
 207                             let ldes =
 208                               if not c then ls2
 209                               else union_list tree ls2 ls
 210                             in
 211                             ldes
 212
 213           | FollowingSibling -> get_followingSibling tree ls
 214
 215           | Parent -> get_parent tree ls
 216
 217           | Ancestor b ->
 218                           let ls3 = get_ancestor tree ls in
 219                           let lac =
 220                           if not b then ls3
 221                           else union_list tree ls3 ls
 222                           in
 223                           lac
 224
 225           | PrecedingSibling -> get_preSibling tree ls
 226
 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
 230                          lp
 231
 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
 235                          lf
 236
 237
 238
 239
 240
 241
 242