sql_lexer.mll

   1
   2 {
   3   open Sql_parser
   4   module T = Sql.Type
   5
   6 let error buf callerID =
   7   Error.report "Lexer error : %s" callerID;
   8 (*      update_pos buf;*)
   9         raise Parsing.Parse_error
  10
  11 let advance_line_pos pos =
  12   let module L = Lexing in
  13   {L.pos_fname = pos.L.pos_fname;
  14    pos_lnum = pos.L.pos_lnum + 1;
  15    pos_bol = pos.L.pos_cnum;
  16    pos_cnum = pos.L.pos_cnum;}
  17
  18 let advance_line lexbuf =
  19   lexbuf.Lexing.lex_curr_p <- advance_line_pos lexbuf.Lexing.lex_curr_p
  20
  21 (* use Map or Hashtbl ? *)
  22 let keywords =
  23   let k = ref [
  24    "as",AS;
  25    "on",ON;
  26    "conflict",CONFLICT;
  27    "using",USING;
  28    "natural",NATURAL;
  29    "join",JOIN;
  30    "isnull",TEST_NULL;
  31    "notnull",TEST_NULL;
  32    "between",BETWEEN;
  33    "and",AND;
  34    "escape",ESCAPE;
  35    "not",NOT;
  36    "null",NULL;
  37    "unique",UNIQUE;
  38    "primary",PRIMARY;
  39    "key",KEY;
  40    "default",DEFAULT;
  41    "precision",PRECISION;
  42    "varying",VARYING;
  43    "charset",CHARSET;
  44    "collate",COLLATE;
  45    "national",NATIONAL;
  46    "ascii",ASCII;
  47    "unicode",UNICODE;
  48    "distinct",DISTINCT;
  49    "character",CHARACTER;
  50    "binary",BINARY;
  51    "all",ALL;
  52    "any",ANY;
  53    "some",SOME;
  54    "order",ORDER;
  55    "by",BY;
  56    "limit",LIMIT;
  57    "desc",DESC;
  58    "asc",ASC;
  59    "offset",OFFSET;
  60    "select",SELECT;
  61    "create",CREATE;
  62    "table",TABLE;
  63    "view",VIEW;
  64    "insert",INSERT;
  65    "replace",REPLACE;
  66    "update",UPDATE;
  67    "delete",DELETE;
  68    "from",FROM;
  69    "or",OR;
  70    "into",INTO;
  71    "values",VALUES;
  72    "where",WHERE;
  73    "from",FROM;
  74    "set",SET;
  75    "in",IN;
  76    "group",GROUP;
  77    "having",HAVING;
  78    "union",UNION;
  79    "except",EXCEPT;
  80    "intersect",INTERSECT;
  81    "cross",CROSS;
  82    "temporary",TEMPORARY;
  83    "if",IF;
  84    "exists",EXISTS;
  85   ] in
  86   let all token l = k := !k @ List.map (fun x -> x,token) l in
  87   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count";"sum";"avg"];
  88   all (FUNCTION (Some T.Text)) ["concat";"lower";"upper"];
  89   all (FUNCTION (Some T.Datetime)) ["current_date";"current_timestamp";"current_time"];
  90   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback"];
  91   all JOIN_TYPE1 ["left";"right";"full"];
  92   all JOIN_TYPE2 ["inner";"outer"];
  93   all LIKE_OP ["like";"glob";"regexp";"match"];
  94   all AUTOINCREMENT ["autoincrement";"auto_increment"];
  95 (* standard built-in types
  96       CHARACTER, CHARACTER VARYING, CHARACTER LARGE OBJECT,
  97       BINARY, BINARY VARYING, BINARY LARGE OBJECT,
  98       NUMERIC, DECIMAL, INTEGER, SMALLINT, BIGINT,
  99       FLOAT, REAL, DOUBLE PRECISION,
 100       BOOLEAN,
 101       DATE, TIME, TIMESTAMP, INTERVAL
 102     *)
 103   all T_INTEGER ["integer";"int";"smallint";"bigint";"tinyint";"mediumint";"middleint";"serial"];
 104   all T_INTEGER ["numeric";"decimal";"dec";"fixed"];
 105   all T_BOOLEAN ["bool";"boolean"];
 106   all T_FLOAT ["float";"real";"double";"float4";"float8";"int1";"int2";"int3";"int4";"int8"];
 107   all T_BLOB ["blob";"varbinary";"tinyblob";"mediumblob";"longblob"];
 108   all T_TEXT ["text";"char";"varchar";"tinytext";"mediumtext";"longtext"];
 109   all T_DATETIME ["datetime";"date";"time";"timestamp";"year";];
 110   !k
 111
 112 (*
 113   Q: Why not convert all input to lowercase before lexing?
 114   A: Sometimes SQL is case-sensitive, also string contents should be preserved
 115 *)
 116
 117 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
 118
 119 let get_ident str =
 120   let str = String.lowercase str in
 121   try List.assoc str keywords with Not_found -> IDENT str
 122 }
 123
 124 let digit = ['0'-'9']
 125 let alpha = ['a'-'z' 'A'-'Z']
 126 let ident = (alpha) (alpha | digit | '_' )*
 127 let wsp = [' ' '\r' '\t']
 128 let cmnt = "--" | "//" | "#"
 129
 130 rule ruleStatement props = parse
 131   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 132 (* fixme strings *)
 133   | cmnt wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 134       {
 135         ruleStatement (Props.set props n v) lexbuf
 136       }
 137   | cmnt wsp* "@" (ident+ as name) [^'\n']* '\n'
 138       {
 139         ruleStatement (Props.set props "name" name) lexbuf
 140       }
 141   | cmnt { ignore (ruleComment "" lexbuf); ruleStatement props lexbuf }
 142   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 143   | _ { None }
 144 and
 145 ruleMain = parse
 146   | wsp   { ruleMain lexbuf }
 147   (* update line number *)
 148   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 149
 150   | '('         { LPAREN }
 151   | ')'         { RPAREN }
 152   | ','   { COMMA }
 153   | '.'   { DOT }
 154
 155   | cmnt { ignore (ruleComment "" lexbuf); ruleMain lexbuf }
 156
 157   | "*" { ASTERISK }
 158   | "=" { EQUAL }
 159   | "!" { EXCL }
 160   | "~" { TILDE }
 161   | "||" { CONCAT_OP }
 162   | "+" { PLUS }
 163   | "-" { MINUS }
 164
 165   | "/" | "%" | "|" | "&" { NUM_BINARY_OP }
 166   | ">" | ">=" | "<=" | "<" | "<>" { COMPARISON_OP }
 167
 168   | "?" { PARAM Stmt.Next }
 169   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 170   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 171
 172   | '"' { IDENT (ruleInQuotes "" lexbuf) }
 173   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 174   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 175
 176   | ident as str { get_ident str }
 177   | digit+ as str { INTEGER (int_of_string str) }
 178   | digit+ '.' digit+ as str { FLOAT (float_of_string str) }
 179   | eof         { EOF }
 180   | _           { error lexbuf "ruleMain" }
 181 and
 182 ruleInQuotes acc = parse
 183   | '"'         { acc }
 184   | eof         { error lexbuf "no terminating quote" }
 185   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 186   | "\"\""      { ruleInQuotes (acc ^ "\"") lexbuf }
 187   | [^'"' '\n']+  { ruleInQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 188   | _           { error lexbuf "ruleInQuotes" }
 189 and
 190 ruleInSingleQuotes acc = parse
 191   | '\''              { acc }
 192   | eof         { error lexbuf "no terminating single quote" }
 193   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating single quote" }
 194   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 195   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 196   | _           { error lexbuf "ruleInSingleQuotes" }
 197 and
 198 ruleComment acc = parse
 199   | '\n'              { advance_line lexbuf; acc }
 200   | eof         { acc }
 201   | [^'\n']+    { let s = Lexing.lexeme lexbuf in ruleComment (acc ^ s) lexbuf; }
 202   | _           { error lexbuf "ruleComment"; }
 203
 204 {
 205
 206   let parse_rule lexbuf = ruleMain lexbuf
 207
 208 }