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"];
  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   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
 122   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 123   | _ { None }
 124 and
 125 ruleMain = parse
 126   | wsp   { ruleMain lexbuf }
 127   (* update line number *)
 128   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 129
 130   | '('         { LPAREN }
 131   | ')'         { RPAREN }
 132   | ','   { COMMA }
 133   | '.'   { DOT }
 134
 135   | "--" | "//" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
 136
 137   | "*" { ASTERISK }
 138   | "=" { EQUAL }
 139   | "!" { EXCL }
 140   | "~" { TILDE }
 141   | "||" { CONCAT_OP }
 142   | "+" { PLUS }
 143   | "-" { MINUS }
 144
 145   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 146
 147   | "?" { PARAM Stmt.Next }
 148   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 149   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 150
 151   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 152   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 153
 154   | ident as str { get_ident str }
 155   | digit+ as str { INTEGER (int_of_string str) }
 156   | eof         { EOF }
 157   | _           { error lexbuf "ruleMain" }
 158 and
 159 ruleInSingleQuotes acc = parse
 160   | '\''              { acc }
 161   | eof         { error lexbuf "no terminating quote" }
 162   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 163   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 164   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 165   | _           { error lexbuf "ruleInSingleQuotes" }
 166 and
 167 ruleComment = parse
 168   | '\n'              { advance_line lexbuf; !curStr }
 169   | eof         { !curStr }
 170   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
 171   | _           { error lexbuf "ruleComment"; }
 172
 173 {
 174
 175   let parse_rule lexbuf = ruleMain lexbuf
 176
 177 }