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-02-12 08:32:59 CET by Kim Nguyen>
  18 *)
  19
  20 open Ast
  21 open Auto
  22 open Utils
  23
  24 let mk_atom l b q =
  25   Ata.SFormula.atom_ (Ata.Move.make (l,b,q))
  26
  27 let ( => ) a b = (a, b)
  28 let ( ** ) l q = mk_atom l true q
  29 let ( ++ ) a b = Ata.SFormula.or_ a b
  30 let ( %% ) a b = Ata.SFormula.and_ a b
  31 let ( @: ) a b = StateSet.add a b
  32
  33
  34 let compile_axis_test ax tst inq trs sts =
  35   match ax with
  36   | Self ->
  37       let outq = State.make () in
  38       outq,
  39       (inq, [ tst =>  (`Epsilon ** outq ) ]) :: trs,
  40       outq @: sts
  41
  42   | Child ->
  43       let outq = State.make () in
  44       let outq' = State.make () in
  45       outq',
  46       (inq, [ QNameSet.any => (`Left ** outq)])
  47       :: (outq, [ tst => (`Epsilon ** outq');
  48                   QNameSet.any => (`Right ** outq) ])
  49       :: trs,
  50       outq @: (outq' @: sts)
  51
  52   | Descendant | DescendantOrSelf ->
  53       let dir = if ax = Descendant then `Left else `Epsilon in
  54       let outq = State.make () in
  55       let outq' = State.make () in
  56       outq',
  57       (inq, [ QNameSet.any => (dir ** outq)])
  58       :: (outq, [ tst =>  (`Epsilon ** outq');
  59                   QNameSet.any => ((`Left ** outq) ++ (`Right ** outq))
  60                 ])
  61       :: trs,
  62       outq @: (outq' @: sts)
  63
  64   | Parent ->
  65       let outq = State.make () in
  66       let outq' = State.make () in
  67       let outq'' = State.make () in
  68       let move = (`Up1 ** outq') ++ (`Up2 ** outq) in
  69       outq'',
  70       (inq, [QNameSet.any => move ])
  71       :: (outq, [ QNameSet.any => move ])
  72       :: (outq', [ tst => (`Epsilon ** outq'') ])
  73       :: trs,
  74       outq @: (outq' @: (outq'' @: sts))
  75
  76   | Ancestor | AncestorOrSelf ->
  77       let outq = State.make () in
  78       let outq' = State.make () in
  79       let outq'' = State.make () in
  80       let move =
  81         (if ax = Ancestor then (`Up1 ** outq')
  82          else (`Epsilon ** outq')) ++ (`Up1 ** outq) ++ (`Up2 ** outq)
  83       in
  84       outq'',
  85       (inq, [QNameSet.any => move  ])
  86       :: (outq, [ QNameSet.any => move ])
  87       :: (outq', [ tst => (`Epsilon ** outq'') ])
  88       :: trs,
  89       outq @: (outq' @: (outq'' @: sts))
  90
  91   | FollowingSibling | PrecedingSibling ->
  92       let outq = State.make () in
  93       let outq' = State.make () in
  94       let dir = if ax = FollowingSibling then `Right else `Up2 in
  95       outq',
  96       (inq, [ QNameSet.any => (dir ** outq) ])
  97       :: (outq, [ tst => (`Epsilon ** outq');
  98                   QNameSet.any => (dir ** outq) ])
  99       :: trs,
 100       outq @: (outq' @: sts)
 101
 102   | _ -> assert false