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    "distinct",DISTINCT;
  53    "all",ALL;
  54    "order",ORDER;
  55    "by",BY;
  56    "limit",LIMIT;
  57    "desc",DESC;
  58    "asc",ASC;
  59    "offset",OFFSET;
  60    "select",SELECT;
  61    "create",CREATE;
  62    "table",TABLE;
  63    "insert",INSERT;
  64    "replace",REPLACE;
  65    "update",UPDATE;
  66    "delete",DELETE;
  67    "from",FROM;
  68    "or",OR;
  69    "into",INTO;
  70    "values",VALUES;
  71    "where",WHERE;
  72    "from",FROM;
  73    "not",NOT;
  74    "set",SET;
  75   ] in
  76   let all token l = k := !k @ List.map (fun x -> x,token) l in
  77   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";];
  78   all (FUNCTION (Some T.Text)) ["concat";];
  79   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
  80   all JOIN_TYPE1 ["left";"right";"full"];
  81   all JOIN_TYPE2 ["inner";"outer";"cross"];
  82   all LIKE_OP ["like";"glob";"regexp";"match"];
  83   !k
  84
  85 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
  86
  87 let get_ident str =
  88   let str = String.lowercase str in
  89   try List.assoc str keywords with Not_found -> IDENT str
  90 }
  91
  92 let digit = ['0'-'9']
  93 let alpha = ['a'-'z' 'A'-'Z']
  94 let ident = (alpha) (alpha | digit | '_' )*
  95 let wsp = [' ' '\r' '\t']
  96
  97 rule ruleStatement props = parse
  98   | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
  99 (* fixme strings *)
 100   | "--" wsp* "[sql2cpp]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
 101       {
 102         ruleStatement (Props.set props n v) lexbuf
 103       }
 104   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
 105   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
 106   | _ { None }
 107 and
 108 ruleMain = parse
 109   | wsp   { ruleMain lexbuf }
 110   (* update line number *)
 111   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
 112
 113   | '('         { LPAREN }
 114   | ')'         { RPAREN }
 115   | ','   { COMMA }
 116   | '.'   { DOT }
 117
 118   | "--" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
 119 (*  | '"' { store ""; ruleInQuotes lexbuf } *)
 120
 121   | "UNION" (wsp+ "ALL")? | "EXCEPT" | "INTERSECT" { COMPOUND_OP }
 122
 123   | "*" { ASTERISK }
 124   | "=" { EQUAL }
 125   | "!" { EXCL }
 126   | "~" { TILDE }
 127   | "||" { CONCAT_OP }
 128   | "+" { PLUS }
 129   | "-" { MINUS }
 130
 131   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
 132
 133   | "?" { PARAM Stmt.Next }
 134   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
 135   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
 136
 137   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
 138   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
 139
 140   | ident as str { get_ident str }
 141   | digit+ as str { INTEGER (int_of_string str) }
 142   | eof         { EOF }
 143   | _           { error lexbuf "ruleMain" }
 144 and
 145 ruleInSingleQuotes acc = parse
 146   | '\''              { acc }
 147   | eof         { error lexbuf "no terminating quote" }
 148   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
 149   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
 150   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
 151   | _           { error lexbuf "ruleInSingleQuotes" }
 152 and
 153 ruleComment = parse
 154   | '\n'              { advance_line lexbuf; !curStr }
 155   | eof         { !curStr }
 156   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
 157   | _           { error lexbuf "ruleComment"; }
 158
 159 {
 160
 161   let parse_rule lexbuf = ruleMain lexbuf
 162
 163 }