minor
[sqlgg.git] / sql_lexer.mll
blob013ce8420add2ef8137e18c661d9d4f58a42c5c3
1 (*
2   $Id$ 
3 *)
6   open Sql_parser
7   module T = Sql.Type
9   let curStr = ref ""
10   let store str = curStr := str
12 let error buf callerID =
13   Error.report "Lexer error : %s" callerID;
14 (*      update_pos buf;*)
15         raise Parsing.Parse_error
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}
24 let advance_line lexbuf = 
25   lexbuf.Lexing.lex_curr_p <- advance_line_pos lexbuf.Lexing.lex_curr_p
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   ] in
69   let all token l = k := !k @ List.map (fun x -> x,token) l in
70   all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";];
71   all (FUNCTION (Some T.Text)) ["concat";];
72   all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
73   all JOIN_TYPE1 ["left";"right";"full"];
74   all JOIN_TYPE2 ["inner";"outer";"cross"];
75   all LIKE_OP ["like";"glob";"regexp";"match"];
76   !k 
78 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
80 let get_ident str =
81   let str = String.lowercase str in
82   try List.assoc str keywords with Not_found -> IDENT str 
85 let digit = ['0'-'9']
86 let alpha = ['a'-'z' 'A'-'Z']
87 let ident = (alpha) (alpha | digit | '_' )*
88 let wsp = [' ' '\t']
90 rule ruleStatement props = parse
91   | ['\n' ' ' '\t']+ { ruleStatement props lexbuf }
92 (* fixme strings *)
93   | "--" wsp* "[sql2cpp]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n' 
94       { 
95         ruleStatement (Props.set props n v) lexbuf
96       }
97   | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
98   | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
99   | _ { None }
101 ruleMain = parse
102   | wsp   { ruleMain lexbuf }
103   (* update line number *)
104   | '\n'  { advance_line lexbuf; ruleMain lexbuf}
106   | '('         { LPAREN }
107   | ')'         { RPAREN }
108   | ','   { COMMA }
109   | '.'   { DOT }
111   | "--" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
112 (*  | '"' { store ""; ruleInQuotes lexbuf } *)
114   | "OR" { OR }
115   | "INTO" { INTO }
116   | "VALUES" { VALUES }
117   | "WHERE" { WHERE }
118   | "FROM" { FROM }
119   | "*" { ASTERISK }
120   | "SET" { SET }
122   | "UNION" (wsp+ "ALL")? | "EXCEPT" | "INTERSECT" { COMPOUND_OP }
124   | "=" { EQUAL }
125   | "!" { EXCL }
126   | "~" { TILDE }
127   | "NOT" { NOT }
128   | "||" { CONCAT_OP }
129   | "+" { PLUS }
130   | "-" { MINUS }
132   | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
134   | "?" { PARAM Stmt.Next }
135   | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
136   | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
138   | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
139   | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
141   | ident as str { get_ident str }
142   | digit+ as str { INTEGER (int_of_string str) }
143   | eof         { EOF }
144   | _           { error lexbuf "ruleMain" }
145 and 
146 ruleInSingleQuotes acc = parse
147   | '\''              { acc }
148   | eof         { error lexbuf "no terminating quote" }
149   | '\n'        { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
150   | "''"        { ruleInSingleQuotes (acc ^ "'") lexbuf }
151   | [^'\'' '\n']+  { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
152   | _           { error lexbuf "ruleInSingleQuotes" }
154 ruleComment = parse
155   | '\n'              { advance_line lexbuf; !curStr }
156   | eof         { !curStr }
157   | [^'\n']+    { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
158   | _           { error lexbuf "ruleComment"; }
162   let parse_rule lexbuf = ruleMain lexbuf