From e40191ae5c8931b10fffa350b7cf9141ccee2200 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Mon, 11 Feb 2013 18:54:28 +0100
Subject: [PATCH] Compilation of the axis part of an XPath expression.

---
 src/test.ml          |   4 +-
 src/xpath.mlpack     |   1 +
 src/xpath/compile.ml | 102 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 106 insertions(+), 1 deletion(-)
 create mode 100644 src/xpath/compile.ml

diff --git a/src/test.ml b/src/test.ml
index e854f44..f62e68d 100644
--- a/src/test.ml
+++ b/src/test.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-02-07 10:25:30 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-02-11 22:41:35 CET by Kim Nguyen>
 *)
 
 (** use: xml_file "XPath querie"
@@ -24,6 +24,8 @@
 
 module F = Auto.Formula
 module A = Auto.Ata
+module X = Xpath.Compile
+
 (* to force ocaml build to add Formula to the dependency chain even if
    we don't use it yet*)
 
diff --git a/src/xpath.mlpack b/src/xpath.mlpack
index 7619c15..a4ae491 100644
--- a/src/xpath.mlpack
+++ b/src/xpath.mlpack
@@ -1,4 +1,5 @@
 xpath/Ast
+xpath/Compile
 xpath/Parser
 xpath/Ulexer
 xpath/Xpath_internal_parser
diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
new file mode 100644
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
-- 
2.17.1