1 (***********************************************************************)
5 (* Kim Nguyen, LRI UMR8623 *)
6 (* Université Paris-Sud & CNRS *)
8 (* Copyright 2010-2012 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 *)
14 (***********************************************************************)
18 type path = single_path list
19 and single_path = Absolute of step list | Relative of step list
20 and step = axis * test * expr list
21 and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
22 | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
26 and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
29 | Number of [ `Int of int | `Float of float ]
31 | Fun_call of QName.t * expr list
33 | Binop of expr * binop * expr
40 let text = QNameSet.singleton QName.text
41 let node = QNameSet.any
44 QNameSet.from_list [ QName.text;
51 let pp fmt e = Format.fprintf fmt e
53 let prio e = match e with
56 | Number _ | String _ | Fun_call _ -> 9
57 | Binop (_,op,_) -> begin match op with
58 | Lt | Lte | Gt | Gte -> 7
62 | Mult | Div | Mod -> 3
66 let print_binop fmt o =
67 pp fmt "%s" begin match o with
82 let print_unop fmt o =
83 pp fmt "%s" begin match o with
87 let rec print_path fmt p =
88 Pretty.print_list ~sep:" | " print_single_path fmt p
90 and print_single_path fmt p =
92 | Absolute l -> pp fmt "/"; l
95 Pretty.print_list ~sep:"/" print_step fmt l
97 and print_step fmt (axis, test, expr) =
98 pp fmt "%a::%a" print_axis axis print_test test;
102 Pretty.print_list ~sep:" ][ " print_expr fmt l;
105 and print_axis fmt a = pp fmt "%s" (match a with
108 | Descendant -> "descendant"
109 | DescendantOrSelf -> "descendant-or-self"
110 | FollowingSibling -> "following-sibling"
111 | Attribute -> "attribute"
112 | Ancestor -> "ancestor"
113 | AncestorOrSelf -> "ancestor-or-self"
114 | PrecedingSibling -> "preceding-sibling"
116 | Preceding -> "preceding"
117 | Following -> "following"
119 and print_test fmt ts =
121 pp fmt "%s" (List.assoc ts
126 Not_found -> pp fmt "%s"
127 (if QNameSet.is_finite ts
128 then QName.to_string (QNameSet.choose ts)
132 and print_expr fmt = function
133 | Number (`Int(i)) -> pp fmt "%i" i
134 | Number (`Float(f)) -> pp fmt "%f" f
135 | String s -> pp fmt "'%S'" s
136 | Fun_call (n, args) ->
137 pp fmt "%a(" QName.print n;
138 Pretty.print_list ~sep:", " print_expr fmt args;
140 | Path p -> print_path fmt p
141 | Binop (e1, op, e2) as e ->
143 let need_par1 = prio e1 < pe in
144 if need_par1 then pp fmt "(";
145 pp fmt "%a" print_expr e1;
146 if need_par1 then pp fmt ")";
147 pp fmt " %a " print_binop op;
148 let need_par2 = prio e2 < pe in
149 if need_par2 then pp fmt "(";
150 pp fmt "%a" print_expr e2;
151 if need_par2 then pp fmt ")"
152 | Unop (op, e0) as e ->
153 let need_par0 = prio e0 < prio e in
155 if need_par0 then pp fmt "(";
157 if need_par0 then pp fmt ")"