sql_lexer.mll

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