7 let store str = curStr := str
9 let error buf callerID =
10 Error.report "Lexer error : %s" callerID;
12 raise Parsing.Parse_error
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;}
21 let advance_line lexbuf =
22 lexbuf.Lexing.lex_curr_p <- advance_line_pos lexbuf.Lexing.lex_curr_p
24 (* use Map or Hashtbl ? *)
43 "autoincrement",AUTOINCREMENT;
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,
53 DATE, TIME, TIMESTAMP, INTERVAL
89 "intersect",INTERSECT;
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";];
101 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
104 let str = String.lowercase str in
105 try List.assoc str keywords with Not_found -> IDENT str
108 let digit = ['0'-'9']
109 let alpha = ['a'-'z' 'A'-'Z']
110 let ident = (alpha) (alpha | digit | '_' )*
111 let wsp = [' ' '\r' '\t']
113 rule ruleStatement props = parse
114 | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
116 | "--" wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
118 ruleStatement (Props.set props n v) lexbuf
120 | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
121 | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
125 | wsp { ruleMain lexbuf }
126 (* update line number *)
127 | '\n' { advance_line lexbuf; ruleMain lexbuf}
134 | "--" | "//" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
144 | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
146 | "?" { PARAM Stmt.Next }
147 | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
148 | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
150 | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
151 | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
153 | ident as str { get_ident str }
154 | digit+ as str { INTEGER (int_of_string str) }
156 | _ { error lexbuf "ruleMain" }
158 ruleInSingleQuotes acc = parse
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" }
167 | '\n' { advance_line lexbuf; !curStr }
169 | [^'\n']+ { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
170 | _ { error lexbuf "ruleComment"; }
174 let parse_rule lexbuf = ruleMain lexbuf