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    "foreign",FOREIGN;
  86    "global",GLOBAL;
  87    "local",LOCAL;
  88    "value",VALUE;
  89    "references",REFERENCES;
  90    "check",CHECK;
  91    "date",DATE;
  92    "time",TIME;
  93    "timestamp",TIMESTAMP;
  94    "alter",ALTER;
  95    "add",ADD;
  96    "cascade",CASCADE;
  97    "restrict",RESTRICT;
  98    "drop",DROP;
  99    "constraint",CONSTRAINT;
 100    "collate",COLLATE;
 101    "after",AFTER;
 102    "index",INDEX;
 103    "fulltext",FULLTEXT;
 104    "unsigned",UNSIGNED;
 105    "first",FIRST;
 106    "column",COLUMN;
 107   ] in (* more *)
 108   let all token l = k := !k @ List.map (fun x -> x,token) l in
 109   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count";"sum";"avg"];
 110   all (FUNCTION (Some T.Text)) ["concat";"lower";"upper"];
 111   all DATETIME_FUNC ["current_date";"current_timestamp";"current_time";"localtime";"localtimestamp"];
 112   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback"];
 113   all JOIN_TYPE1 ["left";"right";"full"];
 114   all JOIN_TYPE2 ["inner";"outer"];
 115   all LIKE_OP ["like";"glob";"regexp";"match"];
 116   all AUTOINCREMENT ["autoincrement";"auto_increment"];
 117 (* standard built-in types
 118       CHARACTER, CHARACTER VARYING, CHARACTER LARGE OBJECT,
 119       BINARY, BINARY VARYING, BINARY LARGE OBJECT,
 120       NUMERIC, DECIMAL, INTEGER, SMALLINT, BIGINT,
 121       FLOAT, REAL, DOUBLE PRECISION,
 122       BOOLEAN,
 123       DATE, TIME, TIMESTAMP, INTERVAL
 124     *)
 125   all T_INTEGER ["integer";"int";"smallint";"bigint";"tinyint";"mediumint";"middleint";"serial";"identity"];
 126   all T_INTEGER ["numeric";"decimal";"dec";"fixed"];
 127   all T_BOOLEAN ["bool";"boolean"];
 128   all T_FLOAT ["float";"real";"double";"float4";"float8";"int1";"int2";"int3";"int4";"int8"];
 129   all T_BLOB ["blob";"varbinary";"tinyblob";"mediumblob";"longblob"];
 130   all T_TEXT ["text";"char";"varchar";"tinytext";"mediumtext";"longtext"];
 131   all T_DATETIME ["datetime";"year";];
 132   !k
 133
 134 (*
 135   Q: Why not convert all input to lowercase before lexing?
 136   A: Sometimes SQL is case-sensitive, also string contents should be preserved
 137 *)
 138
 139 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
 140
 141 let get_ident str =
 142   let str = String.lowercase str in
 143   try List.assoc str keywords with Not_found -> IDENT str
 144 }
 145
 146 let digit = ['0'-'9']
 147 let alpha = ['a'-'z' 'A'-'Z']
 148 let ident = (alpha) (alpha | digit | '_' )*
 149 let wsp = [' ' '\r' '\t']
 150 let cmnt = "--" | "//" | "#"
 151
 152 rule ruleStatement props = parse
 153   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 154 (* fixme strings *)
 155   | cmnt wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 156       {
 157         ruleStatement (Props.set props n v) lexbuf
 158       }
 159   | cmnt wsp* "@" (ident+ as name) [^'\n']* '\n'
 160       {
 161         ruleStatement (Props.set props "name" name) lexbuf
 162       }
 163   | cmnt { ignore (ruleComment "" lexbuf); ruleStatement props lexbuf }
 164   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 165   | _ { None }
 166 and
 167 ruleMain = parse
 168   | wsp   { ruleMain lexbuf }
 169   (* update line number *)
 170   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 171
 172   | '('         { LPAREN }
 173   | ')'         { RPAREN }
 174   | ','   { COMMA }
 175   | '.'   { DOT }
 176
 177   | cmnt { ignore (ruleComment "" lexbuf); ruleMain lexbuf }
 178
 179   | "*" { ASTERISK }
 180   | "=" { EQUAL }
 181   | "!" { EXCL }
 182   | "~" { TILDE }
 183   | "||" { CONCAT_OP }
 184   | "+" { PLUS }
 185   | "-" { MINUS }
 186
 187   | "/" | "%" | "|" | "&" { NUM_BINARY_OP }
 188   | ">" | ">=" | "<=" | "<" | "<>" { COMPARISON_OP }
 189
 190   | "?" { PARAM Stmt.Next }
 191   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 192   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 193
 194   | '"' { IDENT (ruleInQuotes "" lexbuf) }
 195   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 196   | "`" { IDENT (ruleInBackQuotes "" lexbuf) }
 197   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 198
 199   | ident as str { get_ident str }
 200   | digit+ as str { INTEGER (int_of_string str) }
 201   | digit+ '.' digit+ as str { FLOAT (float_of_string str) }
 202   | eof         { EOF }
 203   | _           { error lexbuf "ruleMain" }
 204 and
 205 ruleInQuotes acc = parse
 206   | '"'         { acc }
 207   | eof         { error lexbuf "no terminating quote" }
 208   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 209   | "\"\""      { ruleInQuotes (acc ^ "\"") lexbuf }
 210   | [^'"' '\n']+  { ruleInQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 211   | _           { error lexbuf "ruleInQuotes" }
 212 and
 213 ruleInSingleQuotes acc = parse
 214   | '\''              { acc }
 215   | eof         { error lexbuf "no terminating single quote" }
 216   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating single quote" }
 217   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 218   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 219   | _           { error lexbuf "ruleInSingleQuotes" }
 220 and
 221 ruleInBackQuotes acc = parse
 222   | '`'         { acc }
 223   | eof         { error lexbuf "no terminating back quote" }
 224   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating back quote" }
 225   | "``"        { ruleInBackQuotes (acc ^ "`") lexbuf }
 226   | [^'`' '\n']+  { ruleInBackQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 227   | _           { error lexbuf "ruleInBackQuotes" }
 228 and
 229 ruleComment acc = parse
 230   | '\n'              { advance_line lexbuf; acc }
 231   | eof         { acc }
 232   | [^'\n']+    { let s = Lexing.lexeme lexbuf in ruleComment (acc ^ s) lexbuf; }
 233   | _           { error lexbuf "ruleComment"; }
 234
 235 {
 236
 237   let parse_rule lexbuf =
 238     let module P = Parser_state in
 239     let token = ruleMain lexbuf in
 240     match !P.mode with
 241     | P.Normal -> token
 242     | P.Ignore ->
 243 (*         Printf.eprintf "ignored: %s\n" (Lexing.lexeme lexbuf); *)
 244       if (token = EOF) then token else IGNORED
 245
 246 }
 247