Compilation of the axis part of an XPath expression.

[tatoo.git] / src / xpath / compile.ml

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
new file mode 100644 (file)
index 0000000..a84a50f
--- /dev/null
+++ b/src/xpath/compile.ml
@@ -0,0 +1,102 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                               TAToo                                 *)
+(*                                                                     *)
+(*                     Kim Nguyen, LRI UMR8623                         *)
+(*                   Université Paris-Sud & CNRS                       *)
+(*                                                                     *)
+(*  Copyright 2010-2013 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.                                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
+  Time-stamp: <Last modified on 2013-02-12 08:32:59 CET by Kim Nguyen>
+*)
+
+open Ast
+open Auto
+open Utils
+
+let mk_atom l b q =
+  Ata.SFormula.atom_ (Ata.Move.make (l,b,q))
+
+let ( => ) a b = (a, b)
+let ( ** ) l q = mk_atom l true q
+let ( ++ ) a b = Ata.SFormula.or_ a b
+let ( %% ) a b = Ata.SFormula.and_ a b
+let ( @: ) a b = StateSet.add a b
+
+
+let compile_axis_test ax tst inq trs sts =
+  match ax with
+  | Self ->
+      let outq = State.make () in
+      outq,
+      (inq, [ tst =>  (`Epsilon ** outq ) ]) :: trs,
+      outq @: sts
+
+  | Child ->
+      let outq = State.make () in
+      let outq' = State.make () in
+      outq',
+      (inq, [ QNameSet.any => (`Left ** outq)])
+      :: (outq, [ tst => (`Epsilon ** outq');
+                  QNameSet.any => (`Right ** outq) ])
+      :: trs,
+      outq @: (outq' @: sts)
+
+  | Descendant | DescendantOrSelf ->
+      let dir = if ax = Descendant then `Left else `Epsilon in
+      let outq = State.make () in
+      let outq' = State.make () in
+      outq',
+      (inq, [ QNameSet.any => (dir ** outq)])
+      :: (outq, [ tst =>  (`Epsilon ** outq');
+                  QNameSet.any => ((`Left ** outq) ++ (`Right ** outq))
+                ])
+      :: trs,
+      outq @: (outq' @: sts)
+
+  | Parent ->
+      let outq = State.make () in
+      let outq' = State.make () in
+      let outq'' = State.make () in
+      let move = (`Up1 ** outq') ++ (`Up2 ** outq) in
+      outq'',
+      (inq, [QNameSet.any => move ])
+      :: (outq, [ QNameSet.any => move ])
+      :: (outq', [ tst => (`Epsilon ** outq'') ])
+      :: trs,
+      outq @: (outq' @: (outq'' @: sts))
+
+  | Ancestor | AncestorOrSelf ->
+      let outq = State.make () in
+      let outq' = State.make () in
+      let outq'' = State.make () in
+      let move =
+        (if ax = Ancestor then (`Up1 ** outq')
+         else (`Epsilon ** outq')) ++ (`Up1 ** outq) ++ (`Up2 ** outq)
+      in
+      outq'',
+      (inq, [QNameSet.any => move  ])
+      :: (outq, [ QNameSet.any => move ])
+      :: (outq', [ tst => (`Epsilon ** outq'') ])
+      :: trs,
+      outq @: (outq' @: (outq'' @: sts))
+
+  | FollowingSibling | PrecedingSibling ->
+      let outq = State.make () in
+      let outq' = State.make () in
+      let dir = if ax = FollowingSibling then `Right else `Up2 in
+      outq',
+      (inq, [ QNameSet.any => (dir ** outq) ])
+      :: (outq, [ tst => (`Epsilon ** outq');
+                  QNameSet.any => (dir ** outq) ])
+      :: trs,
+      outq @: (outq' @: sts)
+
+  | _ -> assert false