--- /dev/null
+SOURCE_DIR=src,src/XPath
+TARGET=main.otarget
+
+
+all:
+ ocamlbuild -Is $(SOURCE_DIR) $(TARGET)
+
+
+clean:
+ ocamlbuild -clean
--- /dev/null
+<src/XPath/*.cmx>: for-pack(XPath)
--- /dev/null
+src/test.native
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(*
+ Time-stamp: <Last modified on 2013-02-05 14:34:06 CET by Kim Nguyen>
+*)
+
+
+type path = single_path list
+and single_path = Absolute of step list | Relative of step list
+and step = axis * test * expr list
+and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
+ | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
+
+and test = QNameSet.t
+
+and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
+and unop = Neg
+and expr =
+ | Number of [ `Int of int | `Float of float ]
+ | String of string
+ | Fun_call of QName.t * expr list
+ | Path of path
+ | Binop of expr * binop * expr
+ | Unop of unop * expr
+
+
+type t = path
+
+
+let text = QNameSet.singleton QName.text
+let node = QNameSet.any
+let star =
+ QNameSet.complement (
+ QNameSet.from_list [ QName.text;
+ QName.document;
+ QName.cdata_section;
+ QName.comment])
+
+
+
+let pp fmt e = Format.fprintf fmt e
+
+let prio e =
+ match e with
+ | Unop (Neg, _) -> 11
+ | Path _ -> 10
+ | Number _ | String _ | Fun_call _ -> 9
+ | Binop (_,op,_) -> begin match op with
+ | Lt | Lte | Gt | Gte -> 7
+ | Neq | Eq -> 6
+ | And -> 5
+ | Or -> 4
+ | Mult | Div | Mod -> 3
+ | Add | Sub -> 2
+ end
+
+let print_binop fmt o =
+ pp fmt "%s" begin match o with
+ | Eq -> "="
+ | Neq -> "!="
+ | Lt -> "<"
+ | Gt -> ">"
+ | Lte -> "<="
+ | Gte -> ">="
+ | Or -> "or"
+ | And -> "and"
+ | Add -> "+"
+ | Sub -> "-"
+ | Mult -> "*"
+ | Div -> "div"
+ | Mod -> "mod"
+ end
+let print_unop fmt o =
+ pp fmt "%s" begin match o with
+ | Neg -> "-"
+ end
+
+let rec print_path fmt p =
+ Pretty.print_list ~sep:" | " print_single_path fmt p
+
+and print_single_path fmt p =
+ let l = match p with
+ | Absolute l -> pp fmt "/"; l
+ | Relative l -> l
+ in
+ Pretty.print_list ~sep:"/" print_step fmt l
+
+and print_step fmt (axis, test, expr) =
+ pp fmt "%a::%a" print_axis axis print_test test;
+ match expr with
+ [] -> ()
+ | l -> pp fmt "[ ";
+ Pretty.print_list ~sep:" ][ " print_expr fmt l;
+ pp fmt " ]"
+
+and print_axis fmt a = pp fmt "%s" begin
+ match a with
+ Self -> "self"
+ | Child -> "child"
+ | Descendant -> "descendant"
+ | DescendantOrSelf -> "descendant-or-self"
+ | FollowingSibling -> "following-sibling"
+ | Attribute -> "attribute"
+ | Ancestor -> "ancestor"
+ | AncestorOrSelf -> "ancestor-or-self"
+ | PrecedingSibling -> "preceding-sibling"
+ | Parent -> "parent"
+ | Preceding -> "preceding"
+ | Following -> "following"
+end
+
+and print_test fmt ts =
+ try
+ pp fmt "%s" (List.assoc ts
+ [ text,"text()";
+ node,"node()";
+ star, "*" ] )
+ with
+ Not_found -> pp fmt "%s"
+ (if QNameSet.is_finite ts
+ then QName.to_string (QNameSet.choose ts)
+ else "<INFINITE>"
+ )
+
+and print_expr fmt = function
+| Number (`Int(i)) -> pp fmt "%i" i
+| Number (`Float(f)) -> pp fmt "%f" f
+| String s -> pp fmt "'%S'" s
+| Fun_call (n, args) ->
+ pp fmt "%a(" QName.print n;
+ Pretty.print_list ~sep:", " print_expr fmt args;
+ pp fmt ")"
+| Path p -> print_path fmt p
+| Binop (e1, op, e2) as e ->
+ let pe = prio e in
+ let need_par1 = prio e1 < pe in
+ if need_par1 then pp fmt "(";
+ pp fmt "%a" print_expr e1;
+ if need_par1 then pp fmt ")";
+ pp fmt " %a " print_binop op;
+ let need_par2 = prio e2 < pe in
+ if need_par2 then pp fmt "(";
+ pp fmt "%a" print_expr e2;
+ if need_par2 then pp fmt ")"
+| Unop (op, e0) as e ->
+ let need_par0 = prio e0 < prio e in
+ print_unop fmt op;
+ if need_par0 then pp fmt "(";
+ print_expr fmt e0;
+ if need_par0 then pp fmt ")"
+
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(*
+ Time-stamp: <Last modified on 2013-02-05 14:34:37 CET by Kim Nguyen>
+*)
+
+type path = single_path list
+and single_path = Absolute of step list | Relative of step list
+and step = axis * test * expr list
+and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
+ | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
+
+and test = QNameSet.t
+
+and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
+and unop = Neg
+and expr =
+ | Number of [ `Int of int | `Float of float ]
+ | String of string
+ | Fun_call of QName.t * expr list
+ | Path of path
+ | Binop of expr * binop * expr
+ | Unop of unop * expr
+type t = path
+val text : QNameSet.t
+val node : QNameSet.t
+val star : QNameSet.t
+val print_binop : Format.formatter -> binop -> unit
+val print_unop : Format.formatter -> unop -> unit
+val print_path : Format.formatter -> path -> unit
+val print_single_path : Format.formatter -> single_path -> unit
+val print_step : Format.formatter -> step -> unit
+val print_axis : Format.formatter -> axis -> unit
+val print_test : Format.formatter -> test -> unit
+val print_expr : Format.formatter -> expr -> unit
+
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(*
+ Time-stamp: <Last modified on 2013-02-05 14:40:30 CET by Kim Nguyen>
+*)
+
+include Xpath_internal_parser
+
+let parse (l : Ulexing.lexbuf) =
+ xpath (fun _ -> Ulexer.token l) (Lexing.from_string "!!dummy!!")
+
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(*
+ Time-stamp: <Last modified on 2013-02-05 14:53:12 CET by Kim Nguyen>
+*)
+
+open Xpath_internal_parser
+
+module L = Ulexing
+
+exception Error of int * int * string
+
+let error i j s = raise (Error (i,j,s))
+
+(***********************************************************)
+(* Buffer for string literals *)
+
+let string_buff = Buffer.create 1024
+
+let store_lexeme lexbuf =
+ Buffer.add_string string_buff (Ulexing.utf8_lexeme lexbuf)
+let store_ascii = Buffer.add_char string_buff
+let store_code = Utf8.store string_buff
+let clear_buff () = Buffer.clear string_buff
+let get_stored_string () =
+ let s = Buffer.contents string_buff in
+ clear_buff ();
+ Buffer.clear string_buff;
+ s
+
+(***********************************************************)
+(* Lexer *)
+
+let illegal lexbuf =
+ error
+ (L.lexeme_start lexbuf)
+ (L.lexeme_end lexbuf)
+ "Illegal character"
+
+let return lexbuf tok = (tok, L.loc lexbuf)
+let return_loc i j tok = (tok, (i,j))
+
+let regexp ncname_char =
+ xml_letter | xml_digit | [ '-' '_' ] | xml_combining_char | xml_extender | "\\."
+
+let hexa_digit = function
+ | '0'..'9' as c -> (Char.code c) - (Char.code '0')
+ | 'a'..'f' as c -> (Char.code c) - (Char.code 'a') + 10
+ | 'A'..'F' as c -> (Char.code c) - (Char.code 'A') + 10
+ | _ -> -1
+
+let regexp ncname = ( xml_letter ncname_char* ) | ('_' ncname_char+)
+let regexp digit = ['0'-'9']
+let regexp float = '-'? digit+ ('.' digit+ (['e''E'] digit+)?)?
+
+let parse_char lexbuf base i =
+ let s = L.latin1_sub_lexeme lexbuf i (L.lexeme_length lexbuf - i - 1) in
+ let r = ref 0 in
+ for i = 0 to String.length s - 1 do
+ let c = hexa_digit s.[i] in
+ if (c >= base) || (c < 0) then
+ error (L.lexeme_start lexbuf) (L.lexeme_end lexbuf) "invalid digit";
+ r := !r * base + c;
+ done;
+ !r
+
+let keyword_or_tag s =
+ try
+ List.assoc s [
+ "self", AXIS Ast.Self;
+ "descendant", AXIS Ast.Descendant;
+ "child", AXIS Ast.Child;
+ "descendant-or-self", AXIS Ast.DescendantOrSelf;
+ "attribute", AXIS Ast.Attribute;
+ "following-sibling", AXIS Ast.FollowingSibling;
+ "preceding-sibling", AXIS Ast.PrecedingSibling;
+ "parent", AXIS Ast.Parent;
+ "ancestor", AXIS Ast.Ancestor;
+ "ancestor-or-self", AXIS Ast.AncestorOrSelf;
+ "preceding", AXIS Ast.Preceding;
+ "following", AXIS Ast.Following;
+ "and", AND;
+ "or" , OR;
+ "div", DIV;
+ "mod", MOD;
+ ]
+ with
+ _ -> TAG s
+
+
+let rec token = lexer
+ | [' ' '\t' '\n'] -> token lexbuf
+ | "*" -> STAR
+ | "/" -> SLASH
+ | "//" -> SLASHSLASH
+ | "::" -> COLONCOLON
+ | "(" -> LP
+ | ")" -> RP
+ | "[" -> LB
+ | "]" -> RB
+ | "," -> COMMA
+ | "|" -> PIPE
+ | "+" -> ADD
+ | "-" -> SUB
+ | "<" -> LT
+ | "<=" -> LTE
+ | ">" -> GT
+ | ">=" -> GTE
+ | "=" -> EQ
+ | "!=" -> NEQ
+ | "node()" -> NODE
+ | "text()" -> TEXT
+ | ncname -> keyword_or_tag (L.utf8_lexeme lexbuf)
+ | float ->
+ let s = L.utf8_lexeme lexbuf in
+ (try
+ INT (int_of_string s)
+ with
+ _ -> FLOAT (float_of_string s))
+ | '"' | "'" ->
+ let double_quote = L.latin1_lexeme_char lexbuf 0 = '"' in
+ string (L.lexeme_start lexbuf) double_quote lexbuf;
+ let s = get_stored_string () in
+ STRING s
+
+ | eof -> EOF
+ | _ -> illegal lexbuf
+
+and string start double = lexer
+ | '"' | "'" ->
+ let d = L.latin1_lexeme_char lexbuf 0 = '"' in
+ if d != double then (store_lexeme lexbuf; string start double lexbuf)
+ | '\\' ['\\' '"' '\''] ->
+ store_ascii (L.latin1_lexeme_char lexbuf 1);
+ string start double lexbuf
+ | "\\n" ->
+ store_ascii '\n'; string start double lexbuf
+ | "\\t" ->
+ store_ascii '\t'; string start double lexbuf
+ | "\\r" ->
+ store_ascii '\r'; string start double lexbuf
+ | '\\' ['0'-'9']+ ';' ->
+ store_code (parse_char lexbuf 10 1);
+ string start double lexbuf
+ | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F']+ ';' ->
+ store_code (parse_char lexbuf 16 2);
+ string start double lexbuf
+ | '\\' ->
+ illegal lexbuf;
+ | eof ->
+ error start (start+1) "Unterminated string"
+ | _ ->
+ store_lexeme lexbuf;
+ string start double lexbuf
+
+
--- /dev/null
+%{
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(*
+ Time-stamp: <Last modified on 2013-02-05 14:54:19 CET by Kim Nguyen>
+*)
+
+ open Ast
+ let f () = ()
+%}
+
+%token <string> TAG
+%token <string> STRING
+%token <int> INT
+%token <float> FLOAT
+%token <Ast.axis> AXIS
+%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 COMMA
+%token EOF
+
+%left OR
+%left AND
+%left EQ NEQ
+%left LT GT LTE GTE
+%left ADD SUB
+%left MOD DIV STAR
+%nonassoc uminus
+
+%start xpath
+%type <Ast.path> xpath
+
+
+%%
+xpath:
+path EOF { $1 }
+;
+
+path:
+ path_rev { List.rev $1 }
+;
+
+path_rev:
+ simple_path { [ $1 ] }
+| path_rev PIPE simple_path { $3 :: $1 }
+;
+
+
+simple_path:
+ absolute_path { Absolute (List.rev $1) }
+| relative_path { Relative (List.rev $1) }
+;
+
+absolute_path:
+ SLASH relative_path { $2 }
+| SLASHSLASH relative_path { (DescendantOrSelf, node, []) :: $2 }
+;
+
+relative_path:
+ step { [ $1 ] }
+| relative_path SLASH step { $3 :: $1 }
+| relative_path SLASHSLASH step { $3
+ :: (DescendantOrSelf, node, [])
+ :: $1 }
+;
+
+step:
+ axis_test pred_list { let a, b = $1 in a, b, $2 }
+;
+
+axis_test:
+ AXIS COLONCOLON test { $1, $3 }
+| 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, QNameSet.singleton (QName.of_string a)
+}
+;
+
+test:
+ NODE { node }
+| TEXT { text }
+| STAR { star }
+| TAG { QNameSet.singleton(QName.of_string $1) }
+;
+
+pred_list:
+ pred_list_rev { List.rev $1 }
+;
+
+pred_list_rev:
+ { [] }
+| pred_list LB expr RB { $3 :: $1 }
+;
+
+expr:
+ INT { Number(`Int($1)) }
+| FLOAT { Number(`Float($1)) }
+| STRING { String $1 }
+| SUB expr %prec uminus { Unop(Neg, $2) }
+| expr AND expr { Binop($1, And, $3) }
+| expr OR expr { Binop($1, Or, $3) }
+| expr ADD expr { Binop($1, Add, $3) }
+| expr SUB expr { Binop($1, Sub, $3) }
+| expr STAR expr { Binop($1, Mult, $3) }
+| expr DIV expr { Binop($1, Div, $3) }
+| expr MOD expr { Binop($1, Mod, $3) }
+| expr EQ expr { Binop($1, Eq, $3) }
+| expr NEQ expr { Binop($1, Neq, $3) }
+| expr LT expr { Binop($1, Lt, $3) }
+| 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(QName.of_string $1, $3) }
+| LP expr RP { $2 }
+| path { Path $1 }
+;
+
+arg_list:
+ { [] }
+| arg_list1 { List.rev $1 }
+;
+
+arg_list1:
+ expr { [ $1 ] }
+| arg_list1 COMMA expr { $3 :: $1 }
+;
+
+++ /dev/null
-%{
-(***********************************************************************)
-(* *)
-(* TAToo *)
-(* *)
-(* Kim Nguyen, LRI UMR8623 *)
-(* Université Paris-Sud & CNRS *)
-(* *)
-(* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
-(* Recherche Scientifique. All rights reserved. This file is *)
-(* distributed under the terms of the GNU Lesser General Public *)
-(* License, with the special exception on linking described in file *)
-(* ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(*
- Time-stamp: <Last modified on 2013-01-30 19:08:27 CET by Kim Nguyen>
-*)
-
- open XPath.Ast
- let f () = ()
-%}
-
-%token <string> TAG
-%token <string> STRING
-%token <int> INT
-%token <float> FLOAT
-%token <XPath.Ast.axis> AXIS
-%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 COMMA
-%token EOF
-
-%left OR
-%left AND
-%left EQ NEQ
-%left LT GT LTE GTE
-%left ADD SUB
-%left MOD DIV STAR
-%nonassoc uminus
-
-%start xpath
-%type <XPath.Ast.path> xpath
-
-
-%%
-xpath:
-path EOF { $1 }
-;
-
-path:
- path_rev { List.rev $1 }
-;
-
-path_rev:
- simple_path { [ $1 ] }
-| path_rev PIPE simple_path { $3 :: $1 }
-;
-
-
-simple_path:
- absolute_path { Absolute (List.rev $1) }
-| relative_path { Relative (List.rev $1) }
-;
-
-absolute_path:
- SLASH relative_path { $2 }
-| SLASHSLASH relative_path { (DescendantOrSelf, node, []) :: $2 }
-;
-
-relative_path:
- step { [ $1 ] }
-| relative_path SLASH step { $3 :: $1 }
-| relative_path SLASHSLASH step { $3
- :: (DescendantOrSelf, node, [])
- :: $1 }
-;
-
-step:
- axis_test pred_list { let a, b = $1 in a, b, $2 }
-;
-
-axis_test:
- AXIS COLONCOLON test { $1, $3 }
-| test { Child, $1 }
-| AXIS {
- let _ = Format.flush_str_formatter () in
- let () = Format.fprintf Format.str_formatter "%a" XPath.Ast.print_axis $1 in
- let a = Format.flush_str_formatter () in
- Child, QNameSet.singleton (QName.of_string a)
-}
-;
-
-test:
- NODE { node }
-| TEXT { text }
-| STAR { star }
-| TAG { QNameSet.singleton(QName.of_string $1) }
-;
-
-pred_list:
- pred_list_rev { List.rev $1 }
-;
-
-pred_list_rev:
- { [] }
-| pred_list LB expr RB { $3 :: $1 }
-;
-
-expr:
- INT { Number(`Int($1)) }
-| FLOAT { Number(`Float($1)) }
-| STRING { String $1 }
-| SUB expr %prec uminus { Unop(Neg, $2) }
-| expr AND expr { Binop($1, And, $3) }
-| expr OR expr { Binop($1, Or, $3) }
-| expr ADD expr { Binop($1, Add, $3) }
-| expr SUB expr { Binop($1, Sub, $3) }
-| expr STAR expr { Binop($1, Mult, $3) }
-| expr DIV expr { Binop($1, Div, $3) }
-| expr MOD expr { Binop($1, Mod, $3) }
-| expr EQ expr { Binop($1, Eq, $3) }
-| expr NEQ expr { Binop($1, Neq, $3) }
-| expr LT expr { Binop($1, Lt, $3) }
-| 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(QName.of_string $1, $3) }
-| LP expr RP { $2 }
-| path { Path $1 }
-;
-
-arg_list:
- { [] }
-| arg_list1 { List.rev $1 }
-;
-
-arg_list1:
- expr { [ $1 ] }
-| arg_list1 COMMA expr { $3 :: $1 }
-;
-
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-01-30 19:06:57 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-02-05 14:39:43 CET by Kim Nguyen>
*)
(** use: xml_file "XPath querie"
close_in fd; d
-let query =
+let query =
let arg2 = Sys.argv.(2) in
- Uparser.xpath Ulexer.token (Ulexing.from_latin1_string arg2)
+ XPath.Parser.parse (Ulexing.from_latin1_string arg2)
open Format
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* TAToo *)
-(* *)
-(* Kim Nguyen, LRI UMR8623 *)
-(* Université Paris-Sud & CNRS *)
-(* *)
-(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
-(* Recherche Scientifique. All rights reserved. This file is *)
-(* distributed under the terms of the GNU Lesser General Public *)
-(* License, with the special exception on linking described in file *)
-(* ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(*
- Time-stamp: <Last modified on 2013-01-30 19:06:07 CET by Kim Nguyen>
-*)
-
-open Parser
-
-module L = Ulexing
-
-exception Error of int * int * string
-
-let error i j s = raise (Error (i,j,s))
-
-(***********************************************************)
-(* Buffer for string literals *)
-
-let string_buff = Buffer.create 1024
-
-let store_lexeme lexbuf =
- Buffer.add_string string_buff (Ulexing.utf8_lexeme lexbuf)
-let store_ascii = Buffer.add_char string_buff
-let store_code = Utf8.store string_buff
-let clear_buff () = Buffer.clear string_buff
-let get_stored_string () =
- let s = Buffer.contents string_buff in
- clear_buff ();
- Buffer.clear string_buff;
- s
-
-(***********************************************************)
-(* Lexer *)
-
-let illegal lexbuf =
- error
- (L.lexeme_start lexbuf)
- (L.lexeme_end lexbuf)
- "Illegal character"
-
-let return lexbuf tok = (tok, L.loc lexbuf)
-let return_loc i j tok = (tok, (i,j))
-
-let regexp ncname_char =
- xml_letter | xml_digit | [ '-' '_' ] | xml_combining_char | xml_extender | "\\."
-
-let hexa_digit = function
- | '0'..'9' as c -> (Char.code c) - (Char.code '0')
- | 'a'..'f' as c -> (Char.code c) - (Char.code 'a') + 10
- | 'A'..'F' as c -> (Char.code c) - (Char.code 'A') + 10
- | _ -> -1
-
-let regexp ncname = ( xml_letter ncname_char* ) | ('_' ncname_char+)
-let regexp digit = ['0'-'9']
-let regexp float = '-'? digit+ ('.' digit+ (['e''E'] digit+)?)?
-
-let parse_char lexbuf base i =
- let s = L.latin1_sub_lexeme lexbuf i (L.lexeme_length lexbuf - i - 1) in
- let r = ref 0 in
- for i = 0 to String.length s - 1 do
- let c = hexa_digit s.[i] in
- if (c >= base) || (c < 0) then
- error (L.lexeme_start lexbuf) (L.lexeme_end lexbuf) "invalid digit";
- r := !r * base + c;
- done;
- !r
-
-let keyword_or_tag s =
- try
- List.assoc s [
- "self", AXIS XPath.Ast.Self;
- "descendant", AXIS XPath.Ast.Descendant;
- "child", AXIS XPath.Ast.Child;
- "descendant-or-self", AXIS XPath.Ast.DescendantOrSelf;
- "attribute", AXIS XPath.Ast.Attribute;
- "following-sibling", AXIS XPath.Ast.FollowingSibling;
- "preceding-sibling", AXIS XPath.Ast.PrecedingSibling;
- "parent", AXIS XPath.Ast.Parent;
- "ancestor", AXIS XPath.Ast.Ancestor;
- "ancestor-or-self", AXIS XPath.Ast.AncestorOrSelf;
- "preceding", AXIS XPath.Ast.Preceding;
- "following", AXIS XPath.Ast.Following;
- "and", AND;
- "or" , OR;
- "div", DIV;
- "mod", MOD;
- ]
- with
- _ -> TAG s
-
-
-let rec token = lexer
- | [' ' '\t' '\n'] -> token lexbuf
- | "*" -> STAR
- | "/" -> SLASH
- | "//" -> SLASHSLASH
- | "::" -> COLONCOLON
- | "(" -> LP
- | ")" -> RP
- | "[" -> LB
- | "]" -> RB
- | "," -> COMMA
- | "|" -> PIPE
- | "+" -> ADD
- | "-" -> SUB
- | "<" -> LT
- | "<=" -> LTE
- | ">" -> GT
- | ">=" -> GTE
- | "=" -> EQ
- | "!=" -> NEQ
- | "node()" -> NODE
- | "text()" -> TEXT
- | ncname -> keyword_or_tag (L.utf8_lexeme lexbuf)
- | float ->
- let s = L.utf8_lexeme lexbuf in
- (try
- INT (int_of_string s)
- with
- _ -> FLOAT (float_of_string s))
- | '"' | "'" ->
- let double_quote = L.latin1_lexeme_char lexbuf 0 = '"' in
- string (L.lexeme_start lexbuf) double_quote lexbuf;
- let s = get_stored_string () in
- STRING s
-
- | eof -> EOF
- | _ -> illegal lexbuf
-
-and string start double = lexer
- | '"' | "'" ->
- let d = L.latin1_lexeme_char lexbuf 0 = '"' in
- if d != double then (store_lexeme lexbuf; string start double lexbuf)
- | '\\' ['\\' '"' '\''] ->
- store_ascii (L.latin1_lexeme_char lexbuf 1);
- string start double lexbuf
- | "\\n" ->
- store_ascii '\n'; string start double lexbuf
- | "\\t" ->
- store_ascii '\t'; string start double lexbuf
- | "\\r" ->
- store_ascii '\r'; string start double lexbuf
- | '\\' ['0'-'9']+ ';' ->
- store_code (parse_char lexbuf 10 1);
- string start double lexbuf
- | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F']+ ';' ->
- store_code (parse_char lexbuf 16 2);
- string start double lexbuf
- | '\\' ->
- illegal lexbuf;
- | eof ->
- error start (start+1) "Unterminated string"
- | _ ->
- store_lexeme lexbuf;
- string start double lexbuf
-
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* TAToo *)
-(* *)
-(* Kim Nguyen, LRI UMR8623 *)
-(* Université Paris-Sud & CNRS *)
-(* *)
-(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
-(* Recherche Scientifique. All rights reserved. This file is *)
-(* distributed under the terms of the GNU Lesser General Public *)
-(* License, with the special exception on linking described in file *)
-(* ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(*
- Time-stamp: <Last modified on 2013-01-30 19:06:20 CET by Kim Nguyen>
-*)
-
-let xpath (f : Ulexing.lexbuf -> Parser.token) (l: Ulexing.lexbuf) =
- Parser.xpath (fun _ -> f l) (Lexing.from_string "!!dummy!!")
-
-
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* TAToo *)
-(* *)
-(* Kim Nguyen, LRI UMR8623 *)
-(* Université Paris-Sud & CNRS *)
-(* *)
-(* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
-(* Recherche Scientifique. All rights reserved. This file is *)
-(* distributed under the terms of the GNU Lesser General Public *)
-(* License, with the special exception on linking described in file *)
-(* ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(*
- Time-stamp: <Last modified on 2013-01-30 19:05:13 CET by Kim Nguyen>
-*)
-
-module Ast =
-struct
-
- type path = single_path list
- and single_path = Absolute of step list | Relative of step list
- and step = axis * test * expr list
- and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
- | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
-
- and test = QNameSet.t
-
- and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
- and unop = Neg
- and expr =
- | Number of [ `Int of int | `Float of float ]
- | String of string
- | Fun_call of QName.t * expr list
- | Path of path
- | Binop of expr * binop * expr
- | Unop of unop * expr
-
-
- type t = path
-
-
- let text = QNameSet.singleton QName.text
- let node = QNameSet.any
- let star =
- QNameSet.complement (
- QNameSet.from_list [ QName.text;
- QName.document;
- QName.cdata_section;
- QName.comment])
-
-
-
- let pp fmt e = Format.fprintf fmt e
-
- let prio e = match e with
- | Unop (Neg, _) -> 11
- | Path _ -> 10
- | Number _ | String _ | Fun_call _ -> 9
- | Binop (_,op,_) -> begin match op with
- | Lt | Lte | Gt | Gte -> 7
- | Neq | Eq -> 6
- | And -> 5
- | Or -> 4
- | Mult | Div | Mod -> 3
- | Add | Sub -> 2
- end
-
- let print_binop fmt o =
- pp fmt "%s" begin match o with
- | Eq -> "="
- | Neq -> "!="
- | Lt -> "<"
- | Gt -> ">"
- | Lte -> "<="
- | Gte -> ">="
- | Or -> "or"
- | And -> "and"
- | Add -> "+"
- | Sub -> "-"
- | Mult -> "*"
- | Div -> "div"
- | Mod -> "mod"
- end
- let print_unop fmt o =
- pp fmt "%s" begin match o with
- | Neg -> "-"
- end
-
- let rec print_path fmt p =
- Pretty.print_list ~sep:" | " print_single_path fmt p
-
- and print_single_path fmt p =
- let l = match p with
- | Absolute l -> pp fmt "/"; l
- | Relative l -> l
- in
- Pretty.print_list ~sep:"/" print_step fmt l
-
- and print_step fmt (axis, test, expr) =
- pp fmt "%a::%a" print_axis axis print_test test;
- match expr with
- [] -> ()
- | l -> pp fmt "[ ";
- Pretty.print_list ~sep:" ][ " print_expr fmt l;
- pp fmt " ]"
-
- and print_axis fmt a = pp fmt "%s" (match a with
- Self -> "self"
- | Child -> "child"
- | Descendant -> "descendant"
- | DescendantOrSelf -> "descendant-or-self"
- | FollowingSibling -> "following-sibling"
- | Attribute -> "attribute"
- | Ancestor -> "ancestor"
- | AncestorOrSelf -> "ancestor-or-self"
- | PrecedingSibling -> "preceding-sibling"
- | Parent -> "parent"
- | Preceding -> "preceding"
- | Following -> "following"
- )
- and print_test fmt ts =
- try
- pp fmt "%s" (List.assoc ts
- [ text,"text()";
- node,"node()";
- star, "*" ] )
- with
- Not_found -> pp fmt "%s"
- (if QNameSet.is_finite ts
- then QName.to_string (QNameSet.choose ts)
- else "<INFINITE>"
- )
-
- and print_expr fmt = function
- | Number (`Int(i)) -> pp fmt "%i" i
- | Number (`Float(f)) -> pp fmt "%f" f
- | String s -> pp fmt "'%S'" s
- | Fun_call (n, args) ->
- pp fmt "%a(" QName.print n;
- Pretty.print_list ~sep:", " print_expr fmt args;
- pp fmt ")"
- | Path p -> print_path fmt p
- | Binop (e1, op, e2) as e ->
- let pe = prio e in
- let need_par1 = prio e1 < pe in
- if need_par1 then pp fmt "(";
- pp fmt "%a" print_expr e1;
- if need_par1 then pp fmt ")";
- pp fmt " %a " print_binop op;
- let need_par2 = prio e2 < pe in
- if need_par2 then pp fmt "(";
- pp fmt "%a" print_expr e2;
- if need_par2 then pp fmt ")"
- | Unop (op, e0) as e ->
- let need_par0 = prio e0 < prio e in
- print_unop fmt op;
- if need_par0 then pp fmt "(";
- print_expr fmt e0;
- if need_par0 then pp fmt ")"
-
-end
+++ /dev/null
-(***********************************************************************)
-(* *)
-(* TAToo *)
-(* *)
-(* Kim Nguyen, LRI UMR8623 *)
-(* Université Paris-Sud & CNRS *)
-(* *)
-(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
-(* Recherche Scientifique. All rights reserved. This file is *)
-(* distributed under the terms of the GNU Lesser General Public *)
-(* License, with the special exception on linking described in file *)
-(* ../LICENSE. *)
-(* *)
-(***********************************************************************)
-
-(*
- Time-stamp: <Last modified on 2013-01-30 19:05:02 CET by Kim Nguyen>
-*)
-
-
-
-module Ast :
-sig
- type path = single_path list
- and single_path = Absolute of step list | Relative of step list
- and step = axis * test * expr list
- and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
- | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
-
- and test = QNameSet.t
-
- and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod
- and unop = Neg
- and expr =
- | Number of [ `Int of int | `Float of float ]
- | String of string
- | Fun_call of QName.t * expr list
- | Path of path
- | Binop of expr * binop * expr
- | Unop of unop * expr
- type t = path
- val text : QNameSet.t
- val node : QNameSet.t
- val star : QNameSet.t
- val print_binop : Format.formatter -> binop -> unit
- val print_unop : Format.formatter -> unop -> unit
- val print_path : Format.formatter -> path -> unit
- val print_single_path : Format.formatter -> single_path -> unit
- val print_step : Format.formatter -> step -> unit
- val print_axis : Format.formatter -> axis -> unit
- val print_test : Format.formatter -> test -> unit
- val print_expr : Format.formatter -> expr -> unit
- end
--- /dev/null
+Ast
+Parser
+Ulexer
+Xpath_internal_parser
projects / tatoo.git / commitdiff