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 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 ln =
  let rec aux n acc =
    if n == Naive_tree.nil then  acc
    else let n1 = Naive_tree.first_child tree n in 
	 let acc1 = aux n1 (n::acc) in
	 let n2 = Naive_tree.next_sibling tree n in
	 let acc2 = aux n2 acc1 in
	 acc2
  in
  let ll = List.map (fun n -> 
    let n1 = Naive_tree.first_child tree n in
    aux n1 [] ) ln in
  get_list_ordred tree ll
 (* let l = List.fold_left (fun acc n -> if List.mem n acc then acc 
    else let n1 = Naive_tree.first_child tree n in
	 aux n1 acc) [] ln 
  in
  List.rev l *)

let get_child tree ln =
  let rec aux n acc =
    if n == Naive_tree.nil then acc
    else 
      let n1 = Naive_tree.next_sibling tree n in
      aux n1 (n::acc)
  in
  let ll = List.map (fun  n->
    let n1 = Naive_tree.first_child tree n in
    aux n1 [] )  ln in
  get_list_ordred tree ll

  
let get_followingSibling tree ln =
  let rec aux n acc =
    let n1 = Naive_tree.next_sibling tree n in
    if n1 == Naive_tree.nil then acc
    else aux n1 (n1::acc)
  in
  let ll = List.map (fun n -> aux n [] ) ln in
  get_list_ordred tree ll
  
 
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 ln =
  List.fold_left (fun acc n ->
    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 union_list tree [n2] acc   
    else acc
  ) [] ln
 

let get_ancestor tree ln =
  let rec aux tree l1 acc =
    match l1 with
	[] -> acc
      | _ -> let ll1 = get_parent tree l1 in
	     let acc1 = union_list tree acc ll1 in
	     aux tree ll1  acc1
  in  
  let l = aux tree ln [] in
  l

let get_preSibling tree ln =
  let rec aux n acc =
    let n1 = Naive_tree.prev_sibling tree n in
    if n1 == Naive_tree.nil then acc
    else aux n1 (n1::acc)
  in
  let ll = List.map (fun n -> aux n [] ) ln in
  List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll 
  
    

let rec eval_axis tree ls a =
  let open Xpath.Ast in
	match a with
	    Self -> ls
	      
	  | Attribute -> get_child tree ls
	    
	  | Child -> get_child tree ls
		       
	  | Descendant c -> let ls2 = get_descendant tree ls in
			    let ldes =
			      if not c then ls2
			      else union_list tree ls2 ls
			    in
			    ldes
			      
	  | FollowingSibling -> get_followingSibling tree ls
				  
	  | Parent -> get_parent tree ls
			
	  | Ancestor b -> 
			  let ls3 = get_ancestor tree ls in
			  let lac =
			  if not b then ls3
			  else union_list tree ls3 ls    
			  in
			  lac
			    
	  | PrecedingSibling -> get_preSibling tree ls
				  
	  | Preceding -> let ls2 = eval_axis tree ls (Ancestor true) in
			 let ls3 = eval_axis tree ls2 PrecedingSibling in
			 let lp = eval_axis tree ls3 (Descendant true) in
			 lp
			 
	  | Following -> let ls2 = eval_axis tree ls (Ancestor true) in
			 let ls3 = eval_axis tree ls2 FollowingSibling in
			 let lf = eval_axis tree ls3 (Descendant true) in
			 lf