sql_lexer.mll

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