1 #load "pa_extend.cmo";;
2 let contains = ref None
6 type path = Absolute of step list | AbsoluteDoS of step list| Relative of step list
7 and step = axis * test *predicate
8 and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
9 | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
11 and test = Simple of TagSet.t
12 | Complex of TagSet.t * Tree.Predicate.t
14 and predicate = Or of predicate*predicate
15 | And of predicate*predicate
18 and expression = Path of path
19 | Function of string*expression list
28 let pp fmt = Format.fprintf fmt
29 let print_list printer fmt sep l =
32 | [e] -> printer fmt e
33 | e::es -> printer fmt e; List.iter (fun x -> pp fmt sep;printer fmt x) es
38 | Absolute l -> pp fmt "/"; l
39 | AbsoluteDoS l -> pp fmt "/";
40 print_step fmt (DescendantOrSelf,Simple TagSet.node,Expr True);
44 Pretty.print_list ~sep:"/" print_step fmt l
45 and print_step fmt (axis, test, predicate) =
46 print_axis fmt axis;pp fmt "::";print_test fmt test;
49 | _ -> pp fmt "["; print_predicate fmt predicate; pp fmt "]"
50 and print_axis fmt a = pp fmt "%s" (match a with
53 | Descendant -> "descendant"
54 | DescendantOrSelf -> "descendant-or-self"
55 | FollowingSibling -> "following-sibling"
56 | Attribute -> "attribute"
57 | Ancestor -> "ancestor"
58 | AncestorOrSelf -> "ancestor-or-self"
59 | PrecedingSibling -> "preceding-sibling"
63 and print_test fmt ts =
65 pp fmt "%s" (List.assoc ts
66 [ (Simple (TagSet.pcdata),"text()");
67 (Simple (TagSet.node),"node()");
68 (Simple (TagSet.star),"*")])
70 Not_found -> pp fmt "%s"
72 Simple t | Complex (t, _) -> if TagSet.is_finite t
73 then Tag.to_string (TagSet.choose t)
77 and print_predicate fmt = function
78 | Or(p,q) -> print_predicate fmt p; pp fmt " or "; print_predicate fmt q
79 | And(p,q) -> print_predicate fmt p; pp fmt " and "; print_predicate fmt q
80 | Not p -> pp fmt "not "; print_predicate fmt p
81 | Expr e -> print_expression fmt e
83 and print_expression fmt = function
84 | Path p -> print fmt p
87 Pretty.print_list ~sep:"," print_expression fmt l;
89 | Int i -> pp fmt "%i" i
90 | String s -> pp fmt "\"%s\"" s
91 | t -> pp fmt "%b" (t== True)
98 let predopt = function None -> Expr True | Some p -> p
100 module Gram = Camlp4.Struct.Grammar.Static.Make(Ulexer)
101 let query = Gram.Entry.mk "query"
103 exception Error of Gram.Loc.t*string
104 let test_of_keyword t loc =
106 | "text()" -> TagSet.pcdata
107 | "node()" -> TagSet.node
109 | "and" | "not" | "or" -> TagSet.singleton (Tag.tag t)
110 | _ -> raise (Error(loc,"Invalid test name "^t ))
112 let axis_to_string a = let r = Format.str_formatter in
113 print_axis r a; Format.flush_str_formatter()
116 let t_star = Simple TagSet.star
117 let t_node = Simple TagSet.node
118 let t_text = Simple TagSet.pcdata
124 query : [ [ p = path; `EOI -> p ]]
128 [ "//" ; l = slist -> AbsoluteDoS (List.rev l) ]
129 | [ "/" ; l = slist -> Absolute (List.rev l) ]
130 | [ l = slist -> Relative (List.rev l) ]
135 [ l = slist ;"/"; s = step -> s @ l ]
136 | [ l = slist ; "//"; s = step -> s@[(DescendantOrSelf, t_node ,Expr True)]@l]
141 (* yurk, this is done to parse stuff like
142 a/b/descendant/a where descendant is actually a tag name :(
143 if OPT is None then this is a child::descendant if not, this is a real axis name
147 [ axis = axis ; o = OPT ["::" ; t = test -> t ] ; p = top_pred ->
150 | Some(t) -> (axis,t,p)
151 | None -> (Child,Simple (TagSet.singleton (Tag.tag (axis_to_string axis))),p)
153 | Following -> [ (DescendantOrSelf,t,p);
154 (FollowingSibling, t_star,Expr(True));
155 (Ancestor, t_star ,Expr(True)) ]
157 | Preceding -> [ (DescendantOrSelf,t,p);
158 (PrecedingSibling,t_star,Expr(True));
159 (Ancestor,t_star,Expr(True)) ]
164 | [ "." ; p = top_pred -> [(Self, t_node,p)] ]
165 | [ ".." ; p = top_pred -> [(Parent,t_star,p)] ]
166 | [ test = test; p = top_pred -> [(Child,test, p)] ]
167 | [ att = ATT ; p = top_pred ->
169 | "*" -> [(Attribute,t_star,p)]
170 | _ -> [(Attribute, Simple (TagSet.singleton (Tag.tag att)) ,p )]]
174 [ p = OPT [ "["; p=predicate ;"]" -> p ] -> predopt p ]
178 [ "self" -> Self | "child" -> Child | "descendant" -> Descendant
179 | "descendant-or-self" -> DescendantOrSelf
180 | "ancestor-or-self" -> AncestorOrSelf
181 | "following-sibling" -> FollowingSibling
182 | "attribute" -> Attribute
184 | "ancestor" -> Ancestor
185 | "preceding-sibling" -> PrecedingSibling
186 | "preceding" -> Preceding
187 | "following" -> Following
193 [ s = KWD -> Simple (test_of_keyword s _loc) ]
194 | [ t = TAG -> Simple (TagSet.singleton (Tag.tag t)) ]
200 [ p = predicate; "or"; q = predicate -> Or(p,q) ]
201 | [ p = predicate; "and"; q = predicate -> And(p,q) ]
202 | [ "not" ; p = predicate -> Not p ]
203 | [ "("; p = predicate ;")" -> p ]
204 | [ e = expression -> Expr e ]
208 [ f = TAG; "("; args = LIST0 expression SEP "," ; ")" -> Function(f,args)]
209 | [ `INT(i) -> Int (i) ]
210 | [ s = STRING -> String s ]
211 | [ p = path -> Path p ]
212 | [ "("; e = expression ; ")" -> e ]
221 query : [ [ p = location_path; `EOI -> p ]]
226 [ "/" ; l = OPT relative_location_path ->
227 let l = match l with None -> [] | Some l' -> l' in Absolute l ]
228 | [ l = relative_location_path -> Relative l ]
229 | [ l = abbrev_absolute_location_path -> l ]
234 relative_location_path : [
235 [ s = step -> [ s ] ]
236 | [ l = relative_location_path ; "/"; s = step -> l @ [ s ] ]
237 | [ l = abbrev_relative_location_path -> l ]
243 [ a = axis_specifier ; n = node_test ; p = OPT predicate ->
244 let p = match p with Some p' -> p' | None -> Expr(True) in
247 | [ a = abbrev_step -> a ]
251 [ a = axis_name ; "::" -> a ]
252 | [ a = abbrev_axis_specifier -> a ]
256 [ "self" -> Self | "child" -> Child | "descendant" -> Descendant
257 | "descendant-or-self" -> DescendantOrSelf
258 | "ancestor-or-self" -> AncestorOrSelf
259 | "following-sibling" -> FollowingSibling
260 | "attribute" -> Attribute
262 | "ancestor" -> Ancestor
263 | "preceding-sibling" -> PrecedingSibling
264 | "preceding" -> Preceding
265 | "following" -> Following
270 [ n = name_test -> n ]
271 | [ n = node_type ; "("; ")" -> n ]
272 (* | [ "processing-instruction" ; "(" ... ")" ] *)
276 [ "*" -> Simple(TagSet.star) ]
277 | [ t = axis_name -> Simple(TagSet.singleton (Tag.tag (axis_to_string t))) ]
278 | [ t = TAG -> Simple(TagSet.singleton (Tag.tag t)) ]
282 [ "text" -> Simple(TagSet.pcdata) ]
283 | [ "node" -> Simple(TagSet.node) ]
287 [ "["; e = expr ; "]" -> e ]
290 abbrev_absolute_location_path : [
291 [ "//"; l = relative_location_path -> AbsoluteDoS l ]
294 abbrev_relative_location_path : [
295 [ l = relative_location_path; "//"; s = step ->
296 l @ [ (DescendantOrSelf,Simple(TagSet.node),Expr(True)); s ]
301 [ "." -> (Self, Simple(TagSet.node), Expr(True)) ]
302 | [ ".." -> (Parent, Simple(TagSet.node), Expr(True)) ]
305 abbrev_axis_specifier: [
306 [ a = OPT "@" -> match a with None -> Attribute | _ -> Child ]
314 [ "("; e = expr ; ")" -> e ]
315 | [ s = STRING -> Expr (String s) ]
316 | [ `INT(i) -> Expr (Int (i)) ]
317 | [ f = TAG; "("; args = LIST0 expr SEP "," ; ")" ->
318 Expr(Function(f, List.map (function Expr e -> e | _ -> assert false) args))]
323 [ o1 = or_expr ; "or" ; o2 = and_expr -> Or(o1, o2) ]
324 | [ a = and_expr -> a ]
329 [ a1 = and_expr; "and"; a2 = unary_expr -> And(a1, a2) ]
330 | [ p = unary_expr -> p ]
334 [ l = location_path -> Expr(Path l) ]
335 | [ "not"; "("; e = expr ; ")" -> Not e ]
336 | [ p = primary_expr -> p ]
344 let parse = Gram.parse_string query (Ulexer.Loc.mk "<string>")