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    "autoincrement",AUTOINCREMENT;
  44    "default",DEFAULT;
  45    "text",T_TEXT; (* sqlite specific? *)
  46    "blob",T_BLOB; (* same *)
  47 (* standard built-in types
  48       CHARACTER, CHARACTER VARYING, CHARACTER LARGE OBJECT,
  49       BINARY, BINARY VARYING, BINARY LARGE OBJECT,
  50       NUMERIC, DECIMAL, INTEGER, SMALLINT, BIGINT,
  51       FLOAT, REAL, DOUBLE PRECISION,
  52       BOOLEAN,
  53       DATE, TIME, TIMESTAMP, INTERVAL
  54     *)
  55    "character",T_TEXT;
  56    "char",T_TEXT;
  57    "varchar",T_TEXT;
  58    "binary",T_BLOB;
  59    "float",T_FLOAT;
  60    "real",T_FLOAT;
  61    "boolean",T_BOOLEAN;
  62    "distinct",DISTINCT;
  63    "all",ALL;
  64    "order",ORDER;
  65    "by",BY;
  66    "limit",LIMIT;
  67    "desc",DESC;
  68    "asc",ASC;
  69    "offset",OFFSET;
  70    "select",SELECT;
  71    "create",CREATE;
  72    "table",TABLE;
  73    "insert",INSERT;
  74    "replace",REPLACE;
  75    "update",UPDATE;
  76    "delete",DELETE;
  77    "from",FROM;
  78    "or",OR;
  79    "into",INTO;
  80    "values",VALUES;
  81    "where",WHERE;
  82    "from",FROM;
  83    "set",SET;
  84    "in",IN;
  85    "group",GROUP;
  86    "having",HAVING;
  87    "union",UNION;
  88    "except",EXCEPT;
  89    "intersect",INTERSECT;
  90    "cross",CROSS;
  91   ] in
  92   let all token l = k := !k @ List.map (fun x -> x,token) l in
  93   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count";"sum"];
  94   all (FUNCTION (Some T.Text)) ["concat";];
  95   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
  96   all JOIN_TYPE1 ["left";"right";"full"];
  97   all JOIN_TYPE2 ["inner";"outer"];
  98   all LIKE_OP ["like";"glob";"regexp";"match"];
  99   all T_INTEGER ["integer";"int";"smallint";"bigint";"numeric";"decimal";];
 100   !k
 101
 102 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
 103
 104 let get_ident str =
 105   let str = String.lowercase str in
 106   try List.assoc str keywords with Not_found -> IDENT str
 107 }
 108
 109 let digit = ['0'-'9']
 110 let alpha = ['a'-'z' 'A'-'Z']
 111 let ident = (alpha) (alpha | digit | '_' )*
 112 let wsp = [' ' '\r' '\t']
 113
 114 rule ruleStatement props = parse
 115   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 116 (* fixme strings *)
 117   | "--" wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 118       {
 119         ruleStatement (Props.set props n v) lexbuf
 120       }
 121   | "--" wsp* "@" (ident+ as name) [^'\n']* '\n'
 122       {
 123         ruleStatement (Props.set props "name" name) lexbuf
 124       }
 125   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
 126   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 127   | _ { None }
 128 and
 129 ruleMain = parse
 130   | wsp   { ruleMain lexbuf }
 131   (* update line number *)
 132   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 133
 134   | '('         { LPAREN }
 135   | ')'         { RPAREN }
 136   | ','   { COMMA }
 137   | '.'   { DOT }
 138
 139   | "--" | "//" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
 140
 141   | "*" { ASTERISK }
 142   | "=" { EQUAL }
 143   | "!" { EXCL }
 144   | "~" { TILDE }
 145   | "||" { CONCAT_OP }
 146   | "+" { PLUS }
 147   | "-" { MINUS }
 148
 149   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 150
 151   | "?" { PARAM Stmt.Next }
 152   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 153   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 154
 155   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 156   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 157
 158   | ident as str { get_ident str }
 159   | digit+ as str { INTEGER (int_of_string str) }
 160   | eof         { EOF }
 161   | _           { error lexbuf "ruleMain" }
 162 and
 163 ruleInSingleQuotes acc = parse
 164   | '\''              { acc }
 165   | eof         { error lexbuf "no terminating quote" }
 166   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 167   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 168   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 169   | _           { error lexbuf "ruleInSingleQuotes" }
 170 and
 171 ruleComment = parse
 172   | '\n'              { advance_line lexbuf; !curStr }
 173   | eof         { !curStr }
 174   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
 175   | _           { error lexbuf "ruleComment"; }
 176
 177 {
 178
 179   let parse_rule lexbuf = ruleMain lexbuf
 180
 181 }