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   ] in
  91   let all token l = k := !k @ List.map (fun x -> x,token) l in
  92   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count"];
  93   all (FUNCTION (Some T.Text)) ["concat";];
  94   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
  95   all JOIN_TYPE1 ["left";"right";"full"];
  96   all JOIN_TYPE2 ["inner";"outer";"cross"];
  97   all LIKE_OP ["like";"glob";"regexp";"match"];
  98   all T_INTEGER ["integer";"int";"smallint";"bigint";"numeric";"decimal";];
  99   !k
 100
 101 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
 102
 103 let get_ident str =
 104   let str = String.lowercase str in
 105   try List.assoc str keywords with Not_found -> IDENT str
 106 }
 107
 108 let digit = ['0'-'9']
 109 let alpha = ['a'-'z' 'A'-'Z']
 110 let ident = (alpha) (alpha | digit | '_' )*
 111 let wsp = [' ' '\r' '\t']
 112
 113 rule ruleStatement props = parse
 114   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 115 (* fixme strings *)
 116   | "--" wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 117       {
 118         ruleStatement (Props.set props n v) lexbuf
 119       }
 120   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
 121   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 122   | _ { None }
 123 and
 124 ruleMain = parse
 125   | wsp   { ruleMain lexbuf }
 126   (* update line number *)
 127   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 128
 129   | '('         { LPAREN }
 130   | ')'         { RPAREN }
 131   | ','   { COMMA }
 132   | '.'   { DOT }
 133
 134   | "--" | "//" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
 135
 136   | "*" { ASTERISK }
 137   | "=" { EQUAL }
 138   | "!" { EXCL }
 139   | "~" { TILDE }
 140   | "||" { CONCAT_OP }
 141   | "+" { PLUS }
 142   | "-" { MINUS }
 143
 144   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 145
 146   | "?" { PARAM Stmt.Next }
 147   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 148   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 149
 150   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 151   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 152
 153   | ident as str { get_ident str }
 154   | digit+ as str { INTEGER (int_of_string str) }
 155   | eof         { EOF }
 156   | _           { error lexbuf "ruleMain" }
 157 and
 158 ruleInSingleQuotes acc = parse
 159   | '\''              { acc }
 160   | eof         { error lexbuf "no terminating quote" }
 161   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 162   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 163   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 164   | _           { error lexbuf "ruleInSingleQuotes" }
 165 and
 166 ruleComment = parse
 167   | '\n'              { advance_line lexbuf; !curStr }
 168   | eof         { !curStr }
 169   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
 170   | _           { error lexbuf "ruleComment"; }
 171
 172 {
 173
 174   let parse_rule lexbuf = ruleMain lexbuf
 175
 176 }