src/compil.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                  Lucca Hirschi, ?   *)
   6 (*                  ?   *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
   9 (*  Recherche Scientifique. All rights reserved.  This file is         *)
  10 (*  distributed under the terms of the GNU Lesser General Public       *)
  11 (*  License, with the special exception on linking described in file   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 open XPath.Ast
  17 open Formula.Infix
  18
  19 exception Not_core_XPath
  20 (** Raised whenever the XPath query contains not implemented structures *)
  21
  22 let pr_er = Format.err_formatter
  23
  24 let trans query =
  25   let asta = Asta.empty in
  26   (* Buidling of the ASTA step by step with a special case for the last
  27      step. Then add a top most state. Each function modifies asta. *)
  28   let rec trans = function
  29     | [s] -> trans_last s
  30     | s :: tl -> trans_step s; trans tl
  31     | [] -> ()
  32
  33   and trans_init () =                   (* add THE top most state  *)
  34     let top_st = Asta.new_state () in
  35     let or_top =
  36       List.fold_left (fun acc x -> ((`Left *+ x) +| acc))
  37         (Formula.false_) (Asta.top_states asta)
  38     in
  39     Asta.add_quer asta top_st;
  40     Asta.init_top asta;
  41     Asta.add_top asta top_st;
  42     Asta.add_tr asta (top_st, Asta.any_label, or_top)
  43
  44   and trans_last (ax,test,pred) =       (* a selecting state is needed *)
  45     let fo_p = trans_pr pred in
  46     let q,q' = Asta.new_state(), Asta.new_state() in
  47     Asta.add_selec asta q';
  48     Asta.add_quer asta q;
  49     Asta.add_quer asta q';
  50     Asta.add_top asta q;
  51     Asta.add_top asta q';
  52     Asta.add_bot asta q;
  53     Asta.add_bot asta q';
  54     let Simple lab = test in
  55     let tr_selec = (q', lab, fo_p)
  56     and tr_q = (q, Asta.any_label, form_propa_selec q q' ax) in
  57     Asta.add_tr asta tr_selec;
  58     Asta.add_tr asta tr_q
  59
  60   and trans_step (ax,test,pred) =
  61     ()
  62
  63   and trans_pr  = function              (* either we apply De Morgan rules
  64                                            in xPath:parse or here *)
  65     | Expr True -> Formula.true_
  66     | Expr False -> Formula.false_
  67     | Or (p_1,p_2) -> trans_pr(p_1) +| trans_pr(p_2)
  68     | And (p_1,p_2) -> trans_pr(p_1) *& trans_pr(p_2)
  69     | Not (Expr Path q) -> Formula.true_ (* todo *)
  70     | Expr Path q -> Formula.true_         (* todo *)
  71     | x -> print_predicate pr_er x; raise Not_core_XPath
  72
  73   and form_propa q = function
  74     | Child -> `Right *+ q
  75     | Descendant -> (`Left *+ q +| `Right *+ q)
  76     | x -> print_axis pr_er x; raise Not_core_XPath
  77
  78   and form_propa_selec q q' = function
  79     | Child -> `Right *+ q +| `Right *+ q'
  80     | Descendant -> (`Left *+ q +| `Right *+ q) +| (`Left *+ q' +| `Right *+ q')
  81     | x -> print_axis pr_er x; raise Not_core_XPath
  82
  83   in
  84   match query with
  85     | Absolute steps -> trans steps; trans_init(); asta
  86     | AbsoluteDoS steps as x -> print pr_er x; raise Not_core_XPath
  87     | Relative steps as x -> print pr_er x; raise Not_core_XPath