src/xpath/compile.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                     Kim Nguyen, LRI UMR8623                         *)
   6 (*                   Université Paris-Sud & CNRS                       *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2013 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 (*
  17   Time-stamp: <Last modified on 2013-03-09 11:09:12 CET by Kim Nguyen>
  18 *)
  19
  20 open Ast
  21 open Auto
  22 open Utils
  23
  24
  25 let ( => ) a b = (a, b)
  26 let ( ++ ) a b = Ata.SFormula.or_ a b
  27 let ( %% ) a b = Ata.SFormula.and_ a b
  28 let ( @: ) a b = StateSet.add a b
  29
  30 module F = Ata.SFormula
  31
  32
  33 let node_set = QNameSet.remove QName.document QNameSet.any
  34 let star_set = QNameSet.diff QNameSet.any (
  35   List.fold_right (QNameSet.add)
  36     [ QName.document; QName.text; QName.attribute_map ]
  37     QNameSet.empty)
  38 let attribute = QNameSet.singleton QName.attribute_map
  39 let root_set = QNameSet.singleton QName.document
  40
  41 (* [compile_axis_test axis test q phi trans states] Takes an xpath
  42    [axis] and node [test], a formula [phi], a list of [trans]itions
  43    and a set of [states] and returns a formula [phi'], a new set of
  44    transitions, and a new set of states such that [phi'] holds iff
  45    there exists a node reachable through [axis]::[test] where [phi]
  46    holds.
  47 *)
  48
  49 let compile_axis_test axis test phi trans states =
  50   let q = State.make () in
  51   let phi', trans', states' =
  52     match axis with
  53     | Self ->
  54         (F.stay q,
  55          (q, [  test => phi ]) :: trans,
  56          states)
  57
  58     | Child ->
  59         (F.first_child q,
  60          (q, [ test => phi;
  61                QNameSet.any => F.next_sibling q ]) :: trans,
  62          states)
  63
  64     | Descendant self ->
  65         ((if self then F.stay q else F.first_child q),
  66          (q, [ test => phi;
  67                QNameSet.any => F.first_child q ++ F.next_sibling q;
  68              ]) :: trans,
  69          states)
  70
  71     | Parent ->
  72         let q' = State.make () in
  73         let move = F.parent q ++ F.previous_sibling q' in
  74         (move,
  75          (q, [ test => phi ])
  76          :: (q', [ QNameSet.any => move ]) :: trans,
  77          (q' @: states))
  78
  79     | Ancestor self ->
  80         let q' = State.make () in
  81         let move = F.parent q ++ F.previous_sibling q' in
  82         (if self then F.stay q else move),
  83         (q, [ test => phi;
  84               QNameSet.any => move ])
  85         :: (q', [ QNameSet.any => move ]) :: trans,
  86         (q' @: states)
  87
  88     | FollowingSibling | PrecedingSibling ->
  89         let move =
  90           if axis = PrecedingSibling then
  91             F.previous_sibling q
  92           else F.next_sibling q
  93         in
  94         move,
  95         (q, [ test => phi;
  96               QNameSet.any => move ]) :: trans,
  97         states
  98
  99     | Attribute ->
 100         let test = if QNameSet.is_finite test then
 101             QNameSet.fold (fun tag acc ->
 102               QNameSet.add (QName.add_attribute_prefix tag) acc)
 103               test QNameSet.empty
 104           else test
 105         in
 106         (F.first_child q,
 107          (q, [ test => phi %% F.is_attribute;
 108                QNameSet.any => F.next_sibling q]) :: trans,
 109          states)
 110     | _ -> assert false
 111
 112   in
 113   phi', trans', q @: states'
 114
 115
 116 let compile_rev_axis_test axis test phi trans states =
 117   match axis with
 118   | Attribute -> assert false
 119   | _ -> compile_axis_test (invert_axis axis) test phi trans states
 120
 121 let rec compile_expr e trans states =
 122   match e with
 123   | Binop (e1, (And|Or as op), e2) ->
 124       let phi1, trans1, states1 = compile_expr e1 trans states in
 125       let phi2, trans2, states2 = compile_expr e2 trans1 states1 in
 126       (if op = Or then phi1 ++ phi2 else phi1 %% phi2),
 127       trans2,
 128       states2
 129   | Fun_call (f, [ e0 ]) when (QName.to_string f) = "not" ->
 130       let phi, trans0, states0 = compile_expr e0 trans states in
 131       (Ata.SFormula.not_ phi),
 132       trans0,
 133       states0
 134   | Path p -> compile_path p trans states
 135
 136   | _ -> assert false
 137 and compile_path paths trans states =
 138   List.fold_left (fun (aphi, atrans, astates) p ->
 139     let phi, ntrans, nstates = compile_single_path p atrans astates in
 140     (Ata.SFormula.or_ phi aphi),
 141     ntrans,
 142     nstates) (Ata.SFormula.false_,trans,states) paths
 143
 144 and compile_single_path p trans states =
 145   let steps =
 146     match p with
 147     | Absolute steps ->
 148         (Ancestor false, QNameSet.singleton QName.document, [])::steps
 149     | Relative steps -> steps
 150   in
 151   compile_step_list steps trans states
 152
 153 and compile_step_list l trans states =
 154   match l with
 155   | [] -> Ata.SFormula.true_, trans, states
 156   | (axis, test, elist) :: ll ->
 157       let phi0, trans0, states0 = compile_step_list ll trans states in
 158       let phi1, trans1, states1 =
 159         compile_axis_test axis test phi0 trans0 states0
 160       in
 161       List.fold_left (fun (aphi, atrans, astates) e ->
 162         let ephi, etrans, estates = compile_expr e atrans astates in
 163         aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
 164
 165 let compile_top_level_step_list l trans states =
 166   let rec loop l trans states phi_above =
 167     match l with
 168     | (axis, test, elist) :: [] ->
 169         let phi0, trans0, states0 =
 170           compile_rev_axis_test axis QNameSet.any phi_above trans states
 171         in
 172         let phi1, trans1, states1 =
 173           List.fold_left (fun (aphi, atrans, astates) e ->
 174             let ephi, etrans, estates = compile_expr e atrans astates in
 175             aphi %% ephi, etrans, estates) (phi0, trans0, states0) elist
 176         in
 177         let _, trans2, states2 =
 178           compile_axis_test Self test phi1 trans1 states1
 179           in
 180         let marking_state =
 181           StateSet.choose (StateSet.diff states2 states1)
 182         in
 183         marking_state, trans2, states2
 184     | (axis, test, elist) :: ll ->
 185         let phi0, trans0, states0 =
 186           compile_rev_axis_test axis QNameSet.any phi_above trans states
 187         in
 188         let phi1, trans1, states1 =
 189           compile_axis_test Self test phi0 trans0 states0
 190         in
 191           let phi2, trans2, states2 =
 192             List.fold_left (fun (aphi, atrans, astates) e ->
 193               let ephi, etrans, estates = compile_expr e atrans astates in
 194               aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
 195           in
 196           loop ll trans2 states2 phi2
 197     | _ -> assert false
 198   in
 199   let phi0, trans0, states0 =
 200     compile_axis_test
 201       Self
 202       (QNameSet.singleton QName.document)
 203       Ata.SFormula.true_
 204       trans
 205       states
 206   in
 207   loop l trans0 states0 phi0
 208 ;;
 209
 210
 211 let path p =
 212   let mstates, trans, states = List.fold_left (fun (ams, atrs, asts) p ->
 213     let ms, natrs, nasts =
 214       match p with
 215       | Absolute l | Relative l -> compile_top_level_step_list l atrs asts
 216     in
 217     (StateSet.add ms ams), natrs, nasts) (StateSet.empty, [], StateSet.empty) p
 218   in
 219   let a = Ata.create () in
 220   a.Ata.states <- states;
 221   a.Ata.selection_states <- mstates;
 222   List.iter (fun (q, l) ->
 223     List.iter (fun (lab, phi) ->
 224       Ata.add_trans a q lab phi
 225     ) l) trans;
 226   Ata.complete_transitions a;
 227   Ata.normalize_negations a;
 228   a