Refactor module organisation and build process.

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

diff --git a/src/xpath/ast.ml b/src/xpath/ast.ml
new file mode 100644 (file)
index 0000000..c3c00d9
--- /dev/null
+++ b/src/xpath/ast.ml
@@ -0,0 +1,165 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                               TAToo                                 *)
+(*                                                                     *)
+(*                     Kim Nguyen, LRI UMR8623                         *)
+(*                   Université Paris-Sud & CNRS                       *)
+(*                                                                     *)
+(*  Copyright 2010-2012 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-07 10:04:30 CET by Kim Nguyen>
+*)
+
+open Utils
+
+type path = single_path list
+and single_path = Absolute of step list | Relative of step list
+and step = axis * test * expr list
+and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
+           | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
+
+and test = QNameSet.t
+
+and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
+and unop =  Neg
+and expr =
+  | Number of [ `Int of int | `Float of float ]
+  | String of string
+  | Fun_call of QName.t * expr list
+  | Path of path
+  | Binop of expr * binop * expr
+  | Unop of unop * expr
+
+
+type t = path
+
+
+let text = QNameSet.singleton QName.text
+let node = QNameSet.any
+let star =
+  QNameSet.complement (
+    QNameSet.from_list [ QName.text;
+                         QName.document;
+                         QName.cdata_section;
+                         QName.comment])
+
+
+
+let pp fmt e = Format.fprintf fmt e
+
+let prio e =
+  match e with
+  | Unop (Neg, _) -> 11
+  | Path _ -> 10
+  | Number _ | String _ | Fun_call _ -> 9
+  | Binop (_,op,_) -> begin match op with
+    | Lt | Lte | Gt | Gte -> 7
+    | Neq | Eq -> 6
+    | And -> 5
+    | Or -> 4
+    | Mult | Div | Mod -> 3
+    | Add | Sub -> 2
+  end
+
+let print_binop fmt o =
+  pp fmt "%s" begin match o with
+  | Eq -> "="
+  | Neq -> "!="
+  | Lt -> "<"
+  | Gt -> ">"
+  | Lte -> "<="
+  | Gte -> ">="
+  | Or -> "or"
+  | And -> "and"
+  | Add -> "+"
+  | Sub -> "-"
+  | Mult -> "*"
+  | Div -> "div"
+  | Mod -> "mod"
+  end
+let print_unop fmt o =
+  pp fmt "%s" begin match o with
+  | Neg -> "-"
+  end
+
+let rec print_path fmt p =
+  Pretty.print_list ~sep:" | " print_single_path fmt p
+
+and print_single_path fmt p =
+  let l = match p with
+  | Absolute l -> pp fmt "/"; l
+  | Relative l -> l
+  in
+  Pretty.print_list ~sep:"/" print_step fmt l
+
+and print_step fmt (axis, test, expr) =
+  pp fmt "%a::%a" print_axis axis print_test test;
+  match expr with
+    [] -> ()
+  | l -> pp fmt "[ ";
+      Pretty.print_list ~sep:" ][ " print_expr fmt l;
+      pp fmt " ]"
+
+and print_axis fmt a = pp fmt "%s" begin
+  match a with
+    Self -> "self"
+  | Child -> "child"
+  | Descendant -> "descendant"
+  | DescendantOrSelf -> "descendant-or-self"
+  | FollowingSibling -> "following-sibling"
+  | Attribute -> "attribute"
+  | Ancestor -> "ancestor"
+  | AncestorOrSelf -> "ancestor-or-self"
+  | PrecedingSibling -> "preceding-sibling"
+  | Parent -> "parent"
+  | Preceding -> "preceding"
+  | Following -> "following"
+end
+
+and print_test fmt ts =
+  try
+    pp fmt "%s" (List.assoc ts
+                   [ text,"text()";
+                     node,"node()";
+                     star, "*" ] )
+  with
+    Not_found -> pp fmt "%s"
+      (if QNameSet.is_finite ts
+       then QName.to_string (QNameSet.choose ts)
+       else "<INFINITE>"
+      )
+
+and print_expr fmt = function
+| Number (`Int(i)) -> pp fmt "%i" i
+| Number (`Float(f)) -> pp fmt "%f" f
+| String s -> pp fmt "'%S'" s
+| Fun_call (n, args) ->
+    pp fmt "%a(" QName.print n;
+    Pretty.print_list ~sep:", " print_expr fmt args;
+    pp fmt ")"
+| Path p -> print_path fmt p
+| Binop (e1, op, e2) as e ->
+    let pe = prio e in
+    let need_par1 = prio e1 < pe in
+    if need_par1 then pp fmt "(";
+    pp fmt "%a" print_expr e1;
+    if need_par1 then pp fmt ")";
+    pp fmt " %a "  print_binop op;
+    let need_par2 = prio e2 < pe in
+    if need_par2 then pp fmt "(";
+    pp fmt "%a" print_expr e2;
+    if need_par2 then pp fmt ")"
+| Unop (op, e0) as e ->
+    let need_par0 = prio e0 < prio e in
+    print_unop fmt op;
+    if need_par0 then pp fmt "(";
+    print_expr fmt e0;
+    if need_par0 then pp fmt ")"
+