sql_lexer.mll

   1 (*
   2   $Id$
   3 *)
   4
   5 {
   6   open Sql_parser
   7   module T = Sql.Type
   8
   9   let curStr = ref ""
  10   let store str = curStr := str
  11
  12 let error buf callerID =
  13   Error.report "Lexer error : %s" callerID;
  14 (*      update_pos buf;*)
  15         raise Parsing.Parse_error
  16
  17 let advance_line_pos pos =
  18   let module L = Lexing in
  19   {L.pos_fname=pos.L.pos_fname;
  20    pos_lnum = pos.L.pos_lnum + 1;
  21    pos_bol = 0;
  22    pos_cnum = pos.L.pos_cnum}
  23
  24 let advance_line lexbuf =
  25   lexbuf.Lexing.lex_curr_p <- advance_line_pos lexbuf.Lexing.lex_curr_p
  26
  27 (* use Map or Hashtbl ? *)
  28 let keywords =
  29   let k = ref [
  30    "as",AS;
  31    "on",ON;
  32    "conflict",CONFLICT;
  33    "using",USING;
  34    "natural",NATURAL;
  35    "join",JOIN;
  36    "isnull",TEST_NULL;
  37    "notnull",TEST_NULL;
  38    "between",BETWEEN;
  39    "and",AND;
  40    "escape",ESCAPE;
  41    "not",NOT;
  42    "null",NULL;
  43    "unique",UNIQUE;
  44    "primary",PRIMARY;
  45    "key",KEY;
  46    "autoincrement",AUTOINCREMENT;
  47    "default",DEFAULT;
  48    "text",T_TEXT;
  49    "integer",T_INTEGER;
  50    "int",T_INTEGER;
  51    "blob",T_BLOB;
  52 (*    CHARACTER, CHARACTER VARYING, BIT, BIT VARYING, NUMERIC, DECIMAL,
  53          INTEGER, SMALLINT, FLOAT, REAL, DOUBLE PRECISION, DATE, TIME,
  54          TIMESTAMP, and INTERVAL.*)
  55    "distinct",DISTINCT;
  56    "all",ALL;
  57    "order",ORDER;
  58    "by",BY;
  59    "limit",LIMIT;
  60    "desc",DESC;
  61    "asc",ASC;
  62    "offset",OFFSET;
  63    "select",SELECT;
  64    "create",CREATE;
  65    "table",TABLE;
  66    "insert",INSERT;
  67    "replace",REPLACE;
  68    "update",UPDATE;
  69    "delete",DELETE;
  70    "from",FROM;
  71    "or",OR;
  72    "into",INTO;
  73    "values",VALUES;
  74    "where",WHERE;
  75    "from",FROM;
  76    "not",NOT;
  77    "set",SET;
  78   ] in
  79   let all token l = k := !k @ List.map (fun x -> x,token) l in
  80   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";];
  81   all (FUNCTION (Some T.Text)) ["concat";];
  82   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
  83   all JOIN_TYPE1 ["left";"right";"full"];
  84   all JOIN_TYPE2 ["inner";"outer";"cross"];
  85   all LIKE_OP ["like";"glob";"regexp";"match"];
  86   !k
  87
  88 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
  89
  90 let get_ident str =
  91   let str = String.lowercase str in
  92   try List.assoc str keywords with Not_found -> IDENT str
  93 }
  94
  95 let digit = ['0'-'9']
  96 let alpha = ['a'-'z' 'A'-'Z']
  97 let ident = (alpha) (alpha | digit | '_' )*
  98 let wsp = [' ' '\r' '\t']
  99
 100 rule ruleStatement props = parse
 101   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
 102 (* fixme strings *)
 103   | "--" wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 104       {
 105         ruleStatement (Props.set props n v) lexbuf
 106       }
 107   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
 108   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 109   | _ { None }
 110 and
 111 ruleMain = parse
 112   | wsp   { ruleMain lexbuf }
 113   (* update line number *)
 114   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 115
 116   | '('         { LPAREN }
 117   | ')'         { RPAREN }
 118   | ','   { COMMA }
 119   | '.'   { DOT }
 120
 121   | "--" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
 122 (*  | '"' { store ""; ruleInQuotes lexbuf } *)
 123
 124   | "UNION" (wsp+ "ALL")? | "EXCEPT" | "INTERSECT" { COMPOUND_OP }
 125
 126   | "*" { ASTERISK }
 127   | "=" { EQUAL }
 128   | "!" { EXCL }
 129   | "~" { TILDE }
 130   | "||" { CONCAT_OP }
 131   | "+" { PLUS }
 132   | "-" { MINUS }
 133
 134   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 135
 136   | "?" { PARAM Stmt.Next }
 137   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 138   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 139
 140   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 141   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 142
 143   | ident as str { get_ident str }
 144   | digit+ as str { INTEGER (int_of_string str) }
 145   | eof         { EOF }
 146   | _           { error lexbuf "ruleMain" }
 147 and
 148 ruleInSingleQuotes acc = parse
 149   | '\''              { acc }
 150   | eof         { error lexbuf "no terminating quote" }
 151   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 152   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 153   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 154   | _           { error lexbuf "ruleInSingleQuotes" }
 155 and
 156 ruleComment = parse
 157   | '\n'              { advance_line lexbuf; !curStr }
 158   | eof         { !curStr }
 159   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
 160   | _           { error lexbuf "ruleComment"; }
 161
 162 {
 163
 164   let parse_rule lexbuf = ruleMain lexbuf
 165
 166 }