src/xpath/ulexer.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                     Kim Nguyen, LRI UMR8623                         *)
   6 (*                   Université Paris-Sud & CNRS                       *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
   9 (*  Recherche Scientifique. All rights reserved.  This file is         *)
  10 (*  distributed under the terms of the GNU Lesser General Public       *)
  11 (*  License, with the special exception on linking described in file   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 (*
  17   Time-stamp: <Last modified on 2013-03-13 14:14:15 CET by Kim Nguyen>
  18 *)
  19
  20 open Xpath_internal_parser
  21
  22 module L = Ulexing
  23
  24 exception Error of int * int * string
  25
  26 let error i j s = raise (Error (i,j,s))
  27
  28 (***********************************************************)
  29 (* Buffer for string literals *)
  30
  31 let string_buff = Buffer.create 1024
  32
  33 let store_lexeme lexbuf =
  34   Buffer.add_string string_buff (Ulexing.utf8_lexeme lexbuf)
  35 let store_ascii = Buffer.add_char string_buff
  36 let store_code  = Utf8.store string_buff
  37 let clear_buff () = Buffer.clear string_buff
  38 let get_stored_string () =
  39   let s = Buffer.contents string_buff in
  40   clear_buff ();
  41   Buffer.clear string_buff;
  42   s
  43
  44 (***********************************************************)
  45 (* Lexer *)
  46
  47 let illegal lexbuf =
  48   error
  49     (L.lexeme_start lexbuf)
  50     (L.lexeme_end lexbuf)
  51     "Illegal character"
  52
  53 let return lexbuf tok = (tok, L.loc lexbuf)
  54 let return_loc i j tok = (tok, (i,j))
  55
  56 let regexp ncname_char =
  57   xml_letter | xml_digit | [ '-' '_' '.'] | xml_combining_char | xml_extender
  58
  59 let hexa_digit = function
  60   | '0'..'9' as c -> (Char.code c) - (Char.code '0')
  61   | 'a'..'f' as c -> (Char.code c) - (Char.code 'a') + 10
  62   | 'A'..'F' as c -> (Char.code c) - (Char.code 'A') + 10
  63   | _ -> -1
  64
  65 let regexp ncname = ( xml_letter ncname_char* ) | ('_' ncname_char+)
  66 let regexp digit = ['0'-'9']
  67 let regexp float = '-'? digit+ ('.' digit+ (['e''E'] digit+)?)?
  68
  69 let parse_char lexbuf base i =
  70   let s = L.latin1_sub_lexeme lexbuf i (L.lexeme_length lexbuf - i - 1) in
  71   let r = ref 0 in
  72   for i = 0 to String.length s - 1 do
  73     let c = hexa_digit s.[i] in
  74     if (c >= base) || (c < 0) then
  75       error (L.lexeme_start lexbuf) (L.lexeme_end lexbuf) "invalid digit";
  76     r := !r * base + c;
  77   done;
  78   !r
  79
  80 let keyword_or_tag s =
  81      try
  82        List.assoc s [
  83          "self", AXIS Ast.Self;
  84          "descendant", AXIS (Ast.Descendant false);
  85          "child", AXIS Ast.Child;
  86          "descendant-or-self", AXIS (Ast.Descendant true);
  87          "attribute", AXIS Ast.Attribute;
  88          "following-sibling", AXIS Ast.FollowingSibling;
  89          "preceding-sibling", AXIS Ast.PrecedingSibling;
  90          "parent", AXIS Ast.Parent;
  91          "ancestor", AXIS (Ast.Ancestor false);
  92          "ancestor-or-self", AXIS (Ast.Ancestor true);
  93          "preceding", AXIS Ast.Preceding;
  94          "following", AXIS Ast.Following;
  95          "and", AND;
  96          "or" , OR;
  97          "div", DIV;
  98          "mod", MOD;
  99        ]
 100      with
 101        _ -> TAG s
 102
 103
 104 let rec token = lexer
 105  | [' ' '\t' '\n'] -> token lexbuf
 106  | "*" -> STAR
 107  | "/" -> SLASH
 108  | "//" -> SLASHSLASH
 109  | "::" -> COLONCOLON
 110  | "("  -> LP
 111  | ")"  -> RP
 112  | "["  -> LB
 113  | "]"  -> RB
 114  | ","  -> COMMA
 115  | "|"  -> PIPE
 116  | "+"  -> ADD
 117  | "-"  -> SUB
 118  | "<"  -> LT
 119  | "<=" -> LTE
 120  | ">"  -> GT
 121  | ">=" -> GTE
 122  | "="  -> EQ
 123  | "!=" -> NEQ
 124  | ".." -> DOTDOT
 125  | "."  -> DOT
 126  | "node()" -> NODE
 127  | "text()" -> TEXT
 128  | "comment()" -> COMMENT
 129  | '@' ncname -> ATTNAME (L.utf8_lexeme lexbuf)
 130  | "processing-instruction()" -> PI ""
 131  | "processing-instruction('"ncname"')"
 132  | "processing-instruction(\""ncname"\")"->
 133      let s = L.utf8_lexeme lexbuf in
 134      PI (String.sub s 24 (String.length s - 26))
 135  | ncname -> keyword_or_tag (L.utf8_lexeme lexbuf)
 136  | float ->
 137      let s = L.utf8_lexeme lexbuf in
 138      (try
 139        INT (int_of_string s)
 140      with
 141        _ -> FLOAT (float_of_string s))
 142  | '"' | "'" ->
 143      let double_quote = L.latin1_lexeme_char lexbuf 0 = '"' in
 144      string (L.lexeme_start lexbuf) double_quote lexbuf;
 145      let s = get_stored_string () in
 146      STRING s
 147
 148  | eof -> EOF
 149  | _ -> illegal lexbuf
 150
 151 and string start double = lexer
 152   | '"' | "'" ->
 153       let d = L.latin1_lexeme_char lexbuf 0 = '"' in
 154       if d != double then (store_lexeme lexbuf; string start double lexbuf)
 155   | '\\' ['\\' '"' '\''] ->
 156       store_ascii (L.latin1_lexeme_char lexbuf 1);
 157       string start double lexbuf
 158   | "\\n" ->
 159       store_ascii '\n'; string start double lexbuf
 160   | "\\t" ->
 161       store_ascii '\t'; string start double lexbuf
 162   | "\\r" ->
 163       store_ascii '\r'; string start double lexbuf
 164   | '\\' ['0'-'9']+ ';' ->
 165       store_code (parse_char lexbuf 10 1);
 166       string start double lexbuf
 167   | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F']+ ';' ->
 168       store_code (parse_char lexbuf 16 2);
 169       string start double lexbuf
 170   | '\\' ->
 171       illegal lexbuf;
 172   | eof ->
 173       error start (start+1) "Unterminated string"
 174   | _ ->
 175       store_lexeme lexbuf;
 176       string start double lexbuf