(***********************************************************************)
(*                                                                     *)
(*                               TAToo                                 *)
(*                                                                     *)
(*                  Lucca Hirschi, ?   *)
(*                  ?   *)
(*                                                                     *)
(*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
(*  Recherche Scientifique. All rights reserved.  This file is         *)
(*  distributed under the terms of the GNU Lesser General Public       *)
(*  License, with the special exception on linking described in file   *)
(*  ../LICENSE.                                                        *)
(*                                                                     *)
(***********************************************************************)

open XPath.Ast
open Formula.Infix

exception Not_core_XPath
(** Raised whenever the XPath query contains not implemented structures *)

let pr_er = Format.err_formatter

let trans query =
  let asta = Asta.empty in
  (* Buidling of the ASTA step by step with a special case for the last
     step. Then add a top most state. Each function modifies asta. *)
  let rec trans = function
    | [s] -> trans_last s
    | s :: tl ->  trans tl; trans_step s
    | [] -> ()
      
  and trans_init () = 			(* add THE top most state  *)
    let top_st = Asta.new_state () in
    let or_top = 
      List.fold_left (fun acc x -> ((`Left *+ x) +| acc))
	(Formula.false_) (Asta.top_states asta)
    in
    Asta.add_quer asta top_st;
    Asta.init_top asta;
    Asta.add_top asta top_st;
    Asta.add_tr asta (top_st, Asta.any_label, or_top)
      
  and trans_last (ax,test,pred) =	(* a selecting state is needed *)
    let fo_p = trans_pr pred in
    let q,q' = Asta.new_state(), Asta.new_state() in
    Asta.add_selec asta q';
    Asta.add_quer asta q;
    Asta.add_quer asta q';
    Asta.add_top asta q;
    Asta.add_top asta q';
    Asta.add_bot asta q;
    Asta.add_bot asta q';
    let Simple lab = test in
    let tr_selec = (q', lab, fo_p)
    and tr_q = (q, Asta.any_label, form_propa_selec q q' ax) in
    Asta.add_tr asta tr_selec;
    Asta.add_tr asta tr_q
    
  and trans_step (ax,test,pred) =
    let fo_p = trans_pr pred
    and q = Asta.new_state() in
    let Simple label = test
    and form_next = (fo_p) *&                    (* (\/ top_next) /\ predicat *)
      (List.fold_left (fun acc x -> (`Left *+ x ) +| acc)
	 Formula.false_ (Asta.top_states asta)) in
    let tr_next = (q, label, form_next)
    and tr_propa = (q, Asta.any_label, form_propa q ax) in
    Asta.add_quer asta q;
    Asta.add_top asta q;
    Asta.add_bot asta q;
    Asta.add_tr asta tr_next;
    Asta.add_tr asta tr_propa;
    Asta.init_top asta;
    Asta.add_top asta q
      
  and trans_pr  = function		(* either we apply De Morgan rules
					   in xPath:parse or here *)
    | Expr True -> Formula.true_
    | Expr False -> Formula.false_
    | Or (p_1,p_2) -> trans_pr(p_1) +| trans_pr(p_2)
    | And (p_1,p_2) -> trans_pr(p_1) *& trans_pr(p_2)
    | Not (Expr Path q) -> Formula.true_ (* todo *)
    | Expr Path q -> Formula.true_	   (* todo *)
    | x -> print_predicate pr_er x; raise Not_core_XPath
      
  and form_propa q = function
    | Child -> `Right *+ q
    | Descendant -> (`Left *+ q +| `Right *+ q)
    | x -> print_axis pr_er x; raise Not_core_XPath 

  and form_propa_selec q q' = function
    | Child -> `Right *+ q +| `Right *+ q'
    | Descendant -> (`Left *+ q +| `Right *+ q) +| (`Left *+ q' +| `Right *+ q')
    | x -> print_axis pr_er x; raise Not_core_XPath 
      
  in
  match query with
    | Absolute steps -> trans steps; trans_init(); asta
    | AbsoluteDoS steps as x -> print pr_er x; raise Not_core_XPath
    | Relative steps as x -> print pr_er x; raise Not_core_XPath