X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fxpath_internal_parser.mly;h=a40eea93bd14ca4fca6bd0fe748cf6da186ca2c5;hp=fe38f67d41c342b450b09a5beae0eaaf96e47722;hb=e19136462d2b66532cbed3490d3b5e249f15a7a8;hpb=a58241c37b2151ad75647f003ba933fad6ee7291 diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly index fe38f67..a40eea9 100644 --- a/src/xpath/xpath_internal_parser.mly +++ b/src/xpath/xpath_internal_parser.mly @@ -15,14 +15,16 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Ast - let f () = () + open Tree.Common %} %token TAG +%token PI +%token ATTNAME %token STRING %token INT %token FLOAT @@ -30,7 +32,7 @@ %token RB LB LP RP %token SLASH SLASHSLASH COLONCOLON STAR PIPE %token EQ NEQ LT GT LTE GTE OR AND ADD SUB DIV MOD -%token NODE TEXT +%token NODE TEXT COMMENT %token COMMA %token EOF @@ -68,46 +70,81 @@ simple_path: absolute_path: SLASH relative_path { $2 } -| SLASHSLASH relative_path { $2 @ [(Descendant true, node, [])] } +| SLASHSLASH relative_path { $2 @ + [(Descendant true, + (node, NodeKind.Node), + [])] } ; +/* + step is always a small list, of size 1-3 so @ is + cheap +*/ relative_path: - step { [ $1 ] } -| relative_path SLASH step { $3 :: $1 } -| relative_path SLASHSLASH step { $3 - :: (Descendant true, node, []) - :: $1 } + step { $1 } +| relative_path SLASH step { $3 @ $1 } +| relative_path SLASHSLASH step { $3 @ + ((Descendant true, + (node, NodeKind.Node), + []) + :: $1) } ; step: - axis_test pred_list { let a, b = $1 in a, b, $2 } + axis_test pred_list { + match $1 with + (a,b) :: r -> (a,b,$2) :: (List.map (fun (a,b) -> (a,b,[])) r) + | [] -> assert false + } ; axis_test: - AXIS COLONCOLON test { let a, t = $1, $3 in - if a == Attribute && Utils.QNameSet.is_finite t then - (a, Utils.QNameSet.fold - (fun t a -> - Utils.QNameSet.add - (Utils.QName.add_attribute_prefix t) a) - t Utils.QNameSet.empty) - else - (a, t) + AXIS COLONCOLON test { let a, (t,k) = $1, $3 in + match a with + Attribute when Utils.QNameSet.is_finite t -> + [ a, ((Utils.QNameSet.fold + (fun t a -> + Utils.QNameSet.add + (Utils.QName.attribute t) a) + t Utils.QNameSet.empty), k) ] + | Preceding|Following -> + [ (Descendant true, (t,k)); + if a == Preceding then + (PrecedingSibling, (node, NodeKind.Node)) + else + (FollowingSibling, (node, NodeKind.Node)); + (Ancestor true, (node, NodeKind.Node)) ] + + | _ -> [ a, (t,k) ] } -| test { Child, $1 } +| test { [ Child, $1 ] } | AXIS { let _ = Format.flush_str_formatter () in let () = Format.fprintf Format.str_formatter "%a" Ast.print_axis $1 in let a = Format.flush_str_formatter () in - Child, Utils.QNameSet.singleton (Utils.QName.of_string a) + [Child, (Utils.QNameSet.singleton (Utils.QName.of_string a),NodeKind.Element)] } +| ATTNAME { [(Attribute, + (Utils.QNameSet.singleton (Utils.QName.of_string $1), + NodeKind.Attribute))] } ; test: - NODE { node } -| TEXT { text } -| STAR { star } -| TAG { Utils.QNameSet.singleton(Utils.QName.of_string $1) } + NODE { node, NodeKind.Node } +| TEXT { text, NodeKind.Text } +| STAR { star, NodeKind.Element } +| COMMENT { Utils.QNameSet.singleton(Utils.QName.comment), + NodeKind.Comment + } +| PI { (if $1 = "" then star + else Utils.QNameSet.singleton( + Utils.QName.processing_instruction ( + Utils.QName.of_string $1) + )), NodeKind.ProcessingInstruction + } +| TAG { Utils.QNameSet.singleton(Utils.QName.of_string $1), + NodeKind.Element + } ; pred_list: @@ -151,4 +188,3 @@ arg_list1: expr { [ $1 ] } | arg_list1 COMMA expr { $3 :: $1 } ; -