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;
92 let all token l = k := !k @ List.map (fun x -> x,token) l in
93 all (FUNCTION (Some T.Int)) ["max"; "min"; "length"; "random";"count"];
94 all (FUNCTION (Some T.Text)) ["concat";];
95 all CONFLICT_ALGO ["ignore"; "replace"; "abort"; "fail"; "rollback";];
96 all JOIN_TYPE1 ["left";"right";"full"];
97 all JOIN_TYPE2 ["inner";"outer"];
98 all LIKE_OP ["like";"glob";"regexp";"match"];
99 all T_INTEGER ["integer";"int";"smallint";"bigint";"numeric";"decimal";];
102 let keywords = List.map (fun (k,v) -> (String.lowercase k, v)) keywords
105 let str = String.lowercase str in
106 try List.assoc str keywords with Not_found -> IDENT str
109 let digit = ['0'-'9']
110 let alpha = ['a'-'z' 'A'-'Z']
111 let ident = (alpha) (alpha | digit | '_' )*
112 let wsp = [' ' '\r' '\t']
114 rule ruleStatement props = parse
115 | ['\n' ' ' '\r' '\t']+ { ruleStatement props lexbuf }
117 | "--" wsp* "[sqlgg]" wsp+ (ident+ as n) wsp* "=" wsp* ([^'\n']* as v) '\n'
119 ruleStatement (Props.set props n v) lexbuf
121 | "--" { store ""; ignore (ruleComment lexbuf); ruleStatement props lexbuf }
122 | alpha [^ ';']+ as stmt ';' { Some (stmt,props) }
126 | wsp { ruleMain lexbuf }
127 (* update line number *)
128 | '\n' { advance_line lexbuf; ruleMain lexbuf}
135 | "--" | "//" { store ""; ignore (ruleComment lexbuf); ruleMain lexbuf }
145 | "/" | "%" | ">" | ">=" | "<=" | "<" | "&" | "|" { NUM_BINARY_OP }
147 | "?" { PARAM Stmt.Next }
148 | "?" (digit+ as str) { PARAM (Stmt.Numbered (int_of_string str)) }
149 | [':' '@'] (ident as str) { PARAM (Stmt.Named str) }
151 | "'" { TEXT (ruleInSingleQuotes "" lexbuf) }
152 | ['x' 'X'] "'" { BLOB (ruleInSingleQuotes "" lexbuf) }
154 | ident as str { get_ident str }
155 | digit+ as str { INTEGER (int_of_string str) }
157 | _ { error lexbuf "ruleMain" }
159 ruleInSingleQuotes acc = parse
161 | eof { error lexbuf "no terminating quote" }
162 | '\n' { advance_line lexbuf; error lexbuf "EOL before terminating quote" }
163 | "''" { ruleInSingleQuotes (acc ^ "'") lexbuf }
164 | [^'\'' '\n']+ { ruleInSingleQuotes (acc ^ Lexing.lexeme lexbuf) lexbuf }
165 | _ { error lexbuf "ruleInSingleQuotes" }
168 | '\n' { advance_line lexbuf; !curStr }
170 | [^'\n']+ { store (Lexing.lexeme lexbuf); ruleComment lexbuf; }
171 | _ { error lexbuf "ruleComment"; }
175 let parse_rule lexbuf = ruleMain lexbuf