type query_tree_desc = Binop of op * query_tree * query_tree
		       | Axis of Xpath.Ast.axis * query_tree
		       | Start 
		       | Dom
		       | Tag of QNameSet.t * Tree.NodeKind.t

and op = Union | Inter | Diff

and query_tree = {
  mutable desc  : query_tree_desc;
  mutable id : int;
  mutable hash : int;
}


module QTree = struct
  type t = query_tree
  let rec equal q1 q2 =
    q1 == q2 ||
      (q1.id == q2.id && q1.id != -1) ||
      match q1.desc, q2.desc with
	| Binop(op1,qt1,qt2),Binop(op2,qt3,qt4)-> op1==op2&& (equal qt1 qt3 && equal qt2 qt4) 
							   
	| Axis(a1,qt1),Axis(a2,qt2) -> compare_axis a1 a2 && equal qt1 qt2
	| Tag(t1,k1),Tag(t2,k2) -> t1==t2&& k1==k2
	| Dom,Dom | Start,Start -> true
	| _,_ ->false
  and compare_axis a1 a2 =
    match a1,a2 with
	Self ,Self | Attribute, Attribute | Child , Child | Parent , Parent
      | FollowingSibling , FollowingSibling 	   
      | PrecedingSibling , PrecedingSibling
      | Preceding , Preceding | Following , Following -> true
      | Descendant b1, Descendant b2 -> b1==b2 
      | Ancestor b1, Ancestor b2 -> b1==b2
      | _,_ -> false

  let rec hash q = 
    if q.hash != -1 then q.hash
    else match q.desc with
	Dom -> 1
      | Start -> 3
      | Tag(s,_) -> 5 + 17*QNameSet.hash s
      | Axis(a,q) -> 7 + 17 * Hashtbl.hash a + 23* hash q
      | Binop(op,q1,q2) -> 11 + 17* Hashtbl.hash op + 23* hash q1 + 27* hash q2

end


module QTreeHash = Hashtbl.Make(QTree)

let compare_node tree a b =
  compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b )

let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2)


let rec union_list t l1 l2 =
  match l1,l2 with
    | [],l2 -> l2
    | l1, [] -> l1
    | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h2 :: (union_list t l1 ll2)
      else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
      else h1 ::(union_list t ll1 ll2)

let rec merge_list t l1 l2 =
  match l1,l2 with
    | [],l2 -> l2
    | l1,[] -> l1
    | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
      else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
      else h1::(merge_list t ll1 ll2)

let rec inter_list t l1 l2 =
  match l1,l2 with
    | [],l2 -> []
    | l1, [] -> []
    | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2
      else if (comp_node t h2 h1) then inter_list t l1 ll2
      else h1 :: (inter_list t ll1 ll2)

let rec diff_list t l1 l2 =
  match l1,l2 with
    | [],l2 -> []
    | l1, [] -> l1
    | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2)
      else if (comp_node t h2 h1)  then h2 :: (diff_list t l1 ll2)
      else diff_list t ll1 ll2

let print_node_list tree l =
  List.iter (fun node ->
    Naive_tree.print_xml stdout tree node;
    print_newline() 
  ) l

let rec print_query_tree fmt q =
  match q.desc with
      Dom -> Format.fprintf fmt "Dom"
    | Start -> Format.fprintf fmt "Start"
    | Tag (t,k) -> Format.fprintf fmt "Tag(%a, %a)" QNameSet.print t Tree.NodeKind.print k
    | Axis (a,q) ->
      Format.fprintf fmt "%a(%a)" Xpath.Ast.print_axis a print_query_tree q
    | Binop (op,q1,q2) -> 
      Format.fprintf fmt "%a(%a, %a)"
      print_binop  op
      print_query_tree  q1 
      print_query_tree  q2 
 
and print_binop fmt o =
  match o with
    | Union -> Format.fprintf fmt "Union"
    | Inter -> Format.fprintf fmt "Inter"
    | Diff -> Format.fprintf fmt "Diff"

	   
let rec compare_node_list tree l1 l2 =
  match l1,l2 with
      [],[] -> 0
    | _,[] -> 1
    | [],_ -> -1
    | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
			 if b=0 then compare_node_list tree ll1 ll2 
			 else b



let bitvector_of_nodes tree l =
  let v = Bitvector.create (Naive_tree.size tree) in
  List.iter(fun n -> let j = Naive_tree.preorder tree n in 
		     Bitvector.set v j true ) l;
  v

let decode_bit tree v = 
  let l = ref [] in
  for i = 0 to (Bitvector.length v) - 1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      l := n::!l
  done;
  List.rev !l

let get_list_ordred tree ll =
  let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
  List.rev l1

let get_descendant tree v =
  let rec aux n acc =
    if n == Naive_tree.nil then acc
    else let n1 = Naive_tree.first_child tree n in
	 let j = Naive_tree.preorder tree n in
	 Bitvector.set acc j true;
	 let acc1 = aux n1 acc in
	 let n2 = Naive_tree.next_sibling tree n in
	 aux n2 acc1
  in	    
  let v0 = Bitvector.create (Naive_tree.size tree) in
 (* let v = bitvector_of_nodes tree ln in*)
  for i = 0 to (Bitvector.length v)-1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let n1 = Naive_tree.first_child tree n in
      let _ = aux n1 v0 in ();
  done;
  v0

let get_child tree v =
  let rec aux n acc =
    if n == Naive_tree.nil then acc
    else
      let n1 = Naive_tree.next_sibling tree n in
      Bitvector.set acc (Naive_tree.preorder tree n) true;
      aux n1 acc
  in
  let v0 = Bitvector.create (Naive_tree.size tree) in
  (*let v = bitvector_of_nodes tree ln in*)
  for i = 0 to (Bitvector.length v)-1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let n1 = Naive_tree.first_child tree n in
      let _ = aux n1 v0 in ();
  done;
  v0

  
let get_followingSibling tree v =
  let rec aux n acc =
    let n1 = Naive_tree.next_sibling tree n in
    if n1 == Naive_tree.nil then acc
    else begin
      Bitvector.set acc (Naive_tree.preorder tree n1) true;
      aux n1 acc end
  in
  let v0 = Bitvector.create (Naive_tree.size tree) in
 (* let v = bitvector_of_nodes tree ln in*)
  for i = 0 to (Bitvector.length v)-1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let _ = aux n v0 in ();
  done;
  v0
  
let rec get_firstBling tree n pred =
  if n== Naive_tree.nil then pred
  else get_firstBling tree (Naive_tree.prev_sibling tree n) n
    
let get_parent tree v = 
  let v0 = Bitvector.create (Naive_tree.size tree) in
 (* let v = bitvector_of_nodes tree ln in*)
  for i = 0 to (Bitvector.length v)-1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let n1 = get_firstBling tree n Naive_tree.nil in
      let n2 = Naive_tree.parent_of_first tree n1 in
      if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
					 Bitvector.set v0 j true
      end
  done;
  v0

let get_ancestor tree v =
  let v0 = Bitvector.create (Naive_tree.size tree) in
 (* let v = bitvector_of_nodes tree ln in  *)

  for i = (Bitvector.length v)-1 downto 0 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let n0 = ref n in
      while !n0 != Naive_tree.nil do
	let n1 = get_firstBling tree !n0 Naive_tree.nil in
	let n2 = Naive_tree.parent_of_first tree n1 in
	n0 := n2;
	if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
					   Bitvector.set v0 j true;
					   Bitvector.set v j true;
	end
      done;
  done;
  v0

let get_preSibling tree v =
  let rec aux n acc =
    let n1 = Naive_tree.prev_sibling tree n in
    if n1 == Naive_tree.nil then acc
    else begin
      Bitvector.set acc (Naive_tree.preorder tree n1) true;
      aux n1 acc end
  in
  let v0 = Bitvector.create (Naive_tree.size tree) in
 (* let v = bitvector_of_nodes tree ln in*)
  for i = 0 to (Bitvector.length v)-1 do
    if Bitvector.get v i then
      let n = Naive_tree.by_preorder tree i in
      let _ = aux n v0 in ()
  done;
  v0

  
    

let rec eval_axis tree v a =
  let open Xpath.Ast in
	match a with
	    Self -> v
	      
	  | Attribute -> get_child tree v
	    
	  | Child -> get_child tree v
		       
	  | Descendant c -> let v2 = get_descendant tree v in
			    if not c then v2
			    else Bitvector.union v2 v
			   
			      
	  | FollowingSibling -> get_followingSibling tree v
				  
	  | Parent -> get_parent tree v
			
	  | Ancestor b -> let v2 = get_ancestor tree v in
			  if not b then v2
			  else Bitvector.union v2 v    
			  
			    
	  | PrecedingSibling -> get_preSibling tree v
				  
	  | Preceding -> let v2 = eval_axis tree v (Ancestor true) in
			 let v3 = eval_axis tree v2 PrecedingSibling in
			 eval_axis tree v3 (Descendant true) 
			
			 
	  | Following -> let v2 = eval_axis tree v (Ancestor true) in
			 let v3 = eval_axis tree v2 FollowingSibling in
			 eval_axis tree v3 (Descendant true)