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    "order",ORDER;
  53    "by",BY;
  54    "limit",LIMIT;
  55    "desc",DESC;
  56    "asc",ASC;
  57    "offset",OFFSET;
  58    "select",SELECT;
  59    "create",CREATE;
  60    "table",TABLE;
  61    "insert",INSERT;
  62    "replace",REPLACE;
  63    "update",UPDATE;
  64    "delete",DELETE;
  65    "from",FROM;
  66    "or",OR;
  67    "into",INTO;
  68    "values",VALUES;
  69    "where",WHERE;
  70    "from",FROM;
  71    "set",SET;
  72    "in",IN;
  73    "group",GROUP;
  74    "having",HAVING;
  75    "union",UNION;
  76    "except",EXCEPT;
  77    "intersect",INTERSECT;
  78    "cross",CROSS;
  79    "temporary",TEMPORARY;
  80    "if",IF;
  81    "exists",EXISTS;
  82   ] in
  83   let all token l = k := !k @ List.map (fun x -> x,token) l in
  84   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count";"sum"];
  85   all (FUNCTION (Some T.Text)) ["concat"];
  86   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback"];
  87   all JOIN_TYPE1 ["left";"right";"full"];
  88   all JOIN_TYPE2 ["inner";"outer"];
  89   all LIKE_OP ["like";"glob";"regexp";"match"];
  90   all AUTOINCREMENT ["autoincrement";"auto_increment"];
  91 (* standard built-in types
  92       CHARACTER, CHARACTER VARYING, CHARACTER LARGE OBJECT,
  93       BINARY, BINARY VARYING, BINARY LARGE OBJECT,
  94       NUMERIC, DECIMAL, INTEGER, SMALLINT, BIGINT,
  95       FLOAT, REAL, DOUBLE PRECISION,
  96       BOOLEAN,
  97       DATE, TIME, TIMESTAMP, INTERVAL
  98     *)
  99   all T_INTEGER ["integer";"int";"smallint";"bigint";"tinyint";"mediumint";"middleint";"serial"];
 100   all T_INTEGER ["numeric";"decimal";"dec";"fixed"];
 101   all T_BOOLEAN ["bool";"boolean"];
 102   all T_FLOAT ["float";"real";"double";"float4";"float8";"int1";"int2";"int3";"int4";"int8"];
 103   all T_BLOB ["blob";"varbinary";"tinyblob";"mediumblob";"longblob"];
 104   all T_TEXT ["text";"char";"varchar";"tinytext";"mediumtext";"longtext"];
 105   all T_DATETIME ["datetime";"date";"time";"timestamp";"year";];
 106   !k
 107
 108 (*
 109   Q: Why not convert all input to lowercase before lexing?
 110   A: Sometimes SQL is case-sensitive, also string contents should be preserved
 111 *)
 112
 113 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
 114
 115 let get_ident str =
 116   let str = String.lowercase str in
 117   try List.assoc str keywords with Not_found -> IDENT str
 118 }
 119
 120 let digit = ['0'-'9']
 121 let alpha = ['a'-'z' 'A'-'Z']
 122 let ident = (alpha) (alpha | digit | '_' )*
 123 let wsp = [' ' '\r' '\t']
 124 let cmnt = "--" | "//" | "#"
 125
 126 rule ruleStatement props = parse
 127   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 128 (* fixme strings *)
 129   | cmnt wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 130       {
 131         ruleStatement (Props.set props n v) lexbuf
 132       }
 133   | cmnt wsp* "@" (ident+ as name) [^'\n']* '\n'
 134       {
 135         ruleStatement (Props.set props "name" name) lexbuf
 136       }
 137   | cmnt { ignore (ruleComment "" lexbuf); ruleStatement props lexbuf }
 138   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 139   | _ { None }
 140 and
 141 ruleMain = parse
 142   | wsp   { ruleMain lexbuf }
 143   (* update line number *)
 144   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 145
 146   | '('         { LPAREN }
 147   | ')'         { RPAREN }
 148   | ','   { COMMA }
 149   | '.'   { DOT }
 150
 151   | cmnt { ignore (ruleComment "" lexbuf); ruleMain lexbuf }
 152
 153   | "*" { ASTERISK }
 154   | "=" { EQUAL }
 155   | "!" { EXCL }
 156   | "~" { TILDE }
 157   | "||" { CONCAT_OP }
 158   | "+" { PLUS }
 159   | "-" { MINUS }
 160
 161   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 162
 163   | "?" { PARAM Stmt.Next }
 164   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 165   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 166
 167   | '"' { IDENT (ruleInQuotes "" lexbuf) }
 168   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 169   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 170
 171   | ident as str { get_ident str }
 172   | digit+ as str { INTEGER (int_of_string str) }
 173   | eof         { EOF }
 174   | _           { error lexbuf "ruleMain" }
 175 and
 176 ruleInQuotes acc = parse
 177   | '"'         { acc }
 178   | eof         { error lexbuf "no terminating quote" }
 179   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 180   | "\"\""      { ruleInQuotes (acc ^ "\"") lexbuf }
 181   | [^'"' '\n']+  { ruleInQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 182   | _           { error lexbuf "ruleInQuotes" }
 183 and
 184 ruleInSingleQuotes acc = parse
 185   | '\''              { acc }
 186   | eof         { error lexbuf "no terminating single quote" }
 187   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating single quote" }
 188   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 189   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 190   | _           { error lexbuf "ruleInSingleQuotes" }
 191 and
 192 ruleComment acc = parse
 193   | '\n'              { advance_line lexbuf; acc }
 194   | eof         { acc }
 195   | [^'\n']+    { let s = Lexing.lexeme lexbuf in ruleComment (acc ^ s) lexbuf; }
 196   | _           { error lexbuf "ruleComment"; }
 197
 198 {
 199
 200   let parse_rule lexbuf = ruleMain lexbuf
 201
 202 }