X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fxpath_internal_parser.mly;h=6395b6e38b1e366473b13d9d04f1ef33d8e94e33;hp=a589fde615db58a1b58979608c2e8ff3f2aa9fb3;hb=fe2ba1820282783ae8c10fbbbd2b65d3dc4c67f2;hpb=53a0fd29a20e7f4550e0eb5fa5b0d5af6191c36d diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly index a589fde..6395b6e 100644 --- a/src/xpath/xpath_internal_parser.mly +++ b/src/xpath/xpath_internal_parser.mly @@ -14,12 +14,8 @@ (* *) (***********************************************************************) -(* - Time-stamp: -*) - open Ast - open Tree.Common + open Tree %} %token TAG @@ -30,7 +26,7 @@ %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 COMMENT %token COMMA @@ -76,58 +72,69 @@ absolute_path: [])] } ; +/* + 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, + step { $1 } +| relative_path SLASH step { $3 @ $1 } +| relative_path SLASHSLASH step { $3 @ + ((Descendant true, (node, NodeKind.Node), []) - :: $1 } + :: $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,k) = $1, $3 in - let new_t = - if a == Attribute && Utils.QNameSet.is_finite t then - Utils.QNameSet.fold - (fun t a -> - Utils.QNameSet.add - (Utils.QName.attribute t) a) - t Utils.QNameSet.empty - else t - in - (a, (new_t,k)) + 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),NodeKind.Element) + [Child, (QNameSet.singleton (QName.of_string a),NodeKind.Element)] } -| ATTNAME { (Attribute, - (Utils.QNameSet.singleton (Utils.QName.of_string $1), - NodeKind.Attribute)) } +| ATTNAME { [(Attribute, + (QNameSet.singleton (QName.of_string $1), + NodeKind.Attribute))] } ; test: NODE { node, NodeKind.Node } | TEXT { text, NodeKind.Text } -| STAR { star, NodeKind.Element } -| COMMENT { Utils.QNameSet.singleton(Utils.QName.comment), +| STAR { node, NodeKind.Element } +| COMMENT { QNameSet.singleton(QName.comment), NodeKind.Comment } -| PI { Utils.QNameSet.singleton( - Utils.QName.processing_instruction ( - Utils.QName.of_string $1) - ), NodeKind.ProcessingInstruction +| PI { (if $1 = "" then star + else QNameSet.singleton( + QName.of_string $1 + )), NodeKind.ProcessingInstruction } -| TAG { Utils.QNameSet.singleton(Utils.QName.of_string $1), +| TAG { QNameSet.singleton(QName.of_string $1), NodeKind.Element } ; @@ -159,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 } ;