type move = Self
	    | Firstchild
	    | Nextsibling
	    | Revfirstchild
	    | Prevsibling

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;
}







(*28/01/2014  
  parametres : tree  l'arbre xml
               n     un noeud
               m     move   
  retour :un noeud qui correspond ॆ la relation r
*)

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 eval_relation tree m n =
  match m with
      Self -> n
    | Firstchild ->  Naive_tree.first_child tree n
    | Nextsibling -> Naive_tree.next_sibling tree n
    | Revfirstchild -> Naive_tree.parent_of_first tree n
    | Prevsibling -> Naive_tree.prev_sibling tree n

(*28/01/2014  
  parametres : tree  l'arbre xml
               ls    l'ensemble de noeuds
               m     move   
  retour : l'ensemble de noeuds qui correspondent ॆ la relation r
*)


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

let rec eval_move tree ls m =
  match m with
      Self -> ls
    | r -> List.filter (fun n -> n != Naive_tree.nil)
           (List.map (eval_relation tree r) ls) 
	   

(*28/01/2014  
  parametres : tree  l'arbre xml
               ls    l'ensemble de noeuds
               m     move   
  retour : l'ensemble de noeuds qui correspondent ॆ des relations lr
*)

and eval_star tree ls lr =
  let h = Hashtbl.create 17 in
  let q = Queue.create () in
  List.iter ( fun e -> Queue.add e q ) ls;
  while not (Queue.is_empty q ) do
    let n = Queue.pop q in
    if not (Hashtbl.mem h n) then begin
      Hashtbl.add h n ();
      List.iter ( fun r -> let m = eval_relation tree r n in
			   if m != Naive_tree.nil && not (Hashtbl.mem h m ) then begin
			     
			     Queue.add m q; end
      ) lr
    end
  done;
  let l = Hashtbl.fold (fun k _ acc -> k::acc) h [] in
  List.sort (compare_node tree) l
    
(*28/01/2014  
  parametres : tree  l'arbre xml
               ls    l'ensemble de noeuds
               a     axis   
  retour : l'ensemble de noeuds qui correspondent ॆ l'axe
*)

let keep_elements t l = (*
   List.filter (fun n -> match Naive_tree.kind t n with
     | Element | Text | Document | Attribute -> true | _ -> false) l
			*) l

let keep_attributs t l = (*
  List.filter (fun n -> match Naive_tree.kind t n with
    | Attribute ->true | _ -> false) *) l

let rec eval_axis tree ls a =
  let open Xpath.Ast in
	match a with
	    Self -> ls
	      
	  | Attribute -> let lfc = eval_move tree ls Firstchild in
			 let lc = eval_star tree lfc [Nextsibling] in
			 keep_attributs tree lc
	    
	  | Child -> let lfc = eval_move tree ls Firstchild in
		     let lc = eval_star tree lfc [Nextsibling] in
		     keep_elements tree lc
		       
	  | Descendant c -> let lfc = eval_move tree ls Firstchild in		     
			    let ls2 = eval_star tree lfc [Firstchild;Nextsibling] in
			    let ldes =
			    if not c then ls2
			    else List.merge (compare_node tree) ls2 ls
			    in
			    keep_elements tree ldes
			      
	  | FollowingSibling -> let lnexts = eval_move tree ls Nextsibling in
				let lfs = eval_star tree lnexts [Nextsibling] in
				keep_elements tree lfs
				  
	  | Parent -> let lprevs = eval_star tree ls [Prevsibling] in
		      let lp = eval_move tree lprevs Revfirstchild in
		      keep_elements tree lp
			
	  | Ancestor b -> let ls2 = eval_star tree ls [Revfirstchild;Prevsibling] in
			  let ls3 = eval_move tree ls2 Revfirstchild in
			  let lac =
			  if not b then ls3
			  else List.merge (compare_node tree ) ls3 ls
			  in
			  keep_elements tree lac
			    
	  | PrecedingSibling -> let ls2 = eval_star tree ls [Prevsibling] in
				let lps = eval_move tree ls2 Prevsibling in
				keep_elements tree lps
				  
	  | 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
			 keep_elements tree 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
			 keep_elements tree lf