X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fxpath_internal_parser.mly;h=6395b6e38b1e366473b13d9d04f1ef33d8e94e33;hp=fe38f67d41c342b450b09a5beae0eaaf96e47722;hb=fe2ba1820282783ae8c10fbbbd2b65d3dc4c67f2;hpb=a58241c37b2151ad75647f003ba933fad6ee7291 diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly index fe38f67..6395b6e 100644 --- a/src/xpath/xpath_internal_parser.mly +++ b/src/xpath/xpath_internal_parser.mly @@ -14,23 +14,21 @@ (* *) (***********************************************************************) -(* - Time-stamp: -*) - open Ast - let f () = () + open Tree %} %token TAG +%token PI +%token ATTNAME %token STRING %token INT %token FLOAT %token AXIS %token RB LB LP RP -%token SLASH SLASHSLASH COLONCOLON STAR PIPE +%token SLASH SLASHSLASH COLONCOLON STAR PIPE DOT DOTDOT %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 +66,77 @@ 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 } + DOT { [ (Self, (node, NodeKind.Node), []) ] } +| DOTDOT { [ (Parent, (node, NodeKind.Node), []) ] } +| 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 -> [ a, (t, NodeKind.Attribute) ] + | 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, (QNameSet.singleton (QName.of_string a),NodeKind.Element)] } +| ATTNAME { [(Attribute, + (QNameSet.singleton (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 { node, NodeKind.Element } +| COMMENT { QNameSet.singleton(QName.comment), + NodeKind.Comment + } +| PI { (if $1 = "" then star + else QNameSet.singleton( + QName.of_string $1 + )), NodeKind.ProcessingInstruction + } +| TAG { QNameSet.singleton(QName.of_string $1), + NodeKind.Element + } ; pred_list: @@ -137,7 +166,7 @@ expr: | expr LTE expr { Binop($1, Lte, $3) } | expr GT expr { Binop($1, Gt, $3) } | expr GTE expr { Binop($1, Gte, $3) } -| TAG LP arg_list RP { Fun_call(Utils.QName.of_string $1, $3) } +| TAG LP arg_list RP { Fun_call(QName.of_string $1, $3) } | LP expr RP { $2 } | path { Path $1 } ; @@ -151,4 +180,3 @@ arg_list1: expr { [ $1 ] } | arg_list1 COMMA expr { $3 :: $1 } ; -