ziv@2204
|
1 structure Sql :> SQL = struct
|
ezyang@1697
|
2
|
ezyang@1697
|
3 open Mono
|
ezyang@1697
|
4
|
ezyang@1697
|
5 val debug = ref false
|
ezyang@1697
|
6
|
ezyang@1697
|
7 type lvar = int
|
ezyang@1697
|
8
|
ezyang@1697
|
9 datatype func =
|
ezyang@1697
|
10 DtCon0 of string
|
ezyang@1697
|
11 | DtCon1 of string
|
ezyang@1697
|
12 | UnCon of string
|
ezyang@1697
|
13 | Other of string
|
ezyang@1697
|
14
|
ezyang@1697
|
15 datatype exp =
|
ezyang@1697
|
16 Const of Prim.t
|
ezyang@1697
|
17 | Var of int
|
ezyang@1697
|
18 | Lvar of lvar
|
ezyang@1697
|
19 | Func of func * exp list
|
ezyang@1697
|
20 | Recd of (string * exp) list
|
ezyang@1697
|
21 | Proj of exp * string
|
ezyang@1697
|
22
|
ziv@2216
|
23 datatype cmp =
|
ziv@2216
|
24 Eq
|
ezyang@1697
|
25 | Ne
|
ezyang@1697
|
26 | Lt
|
ezyang@1697
|
27 | Le
|
ezyang@1697
|
28 | Gt
|
ezyang@1697
|
29 | Ge
|
ezyang@1697
|
30
|
ziv@2216
|
31 datatype reln =
|
ziv@2216
|
32 Known
|
ziv@2216
|
33 | Sql of string
|
ziv@2216
|
34 | PCon0 of string
|
ziv@2216
|
35 | PCon1 of string
|
ziv@2216
|
36 | Cmp of cmp
|
ziv@2216
|
37
|
ziv@2216
|
38 datatype lop =
|
ziv@2216
|
39 And
|
ziv@2216
|
40 | Or
|
ziv@2216
|
41
|
ezyang@1697
|
42 datatype prop =
|
ezyang@1697
|
43 True
|
ezyang@1697
|
44 | False
|
ezyang@1697
|
45 | Unknown
|
ziv@2216
|
46 | Lop of lop * prop * prop
|
ezyang@1697
|
47 | Reln of reln * exp list
|
ezyang@1697
|
48 | Cond of exp * prop
|
ezyang@1697
|
49
|
ezyang@1697
|
50 datatype chunk =
|
ezyang@1697
|
51 String of string
|
ezyang@1697
|
52 | Exp of Mono.exp
|
ezyang@1697
|
53
|
ezyang@1697
|
54 fun chunkify e =
|
ezyang@1697
|
55 case #1 e of
|
adam@2048
|
56 EPrim (Prim.String (_, s)) => [String s]
|
ezyang@1697
|
57 | EStrcat (e1, e2) =>
|
ezyang@1697
|
58 let
|
ezyang@1697
|
59 val chs1 = chunkify e1
|
ezyang@1697
|
60 val chs2 = chunkify e2
|
ezyang@1697
|
61 in
|
ezyang@1697
|
62 case chs2 of
|
ezyang@1697
|
63 String s2 :: chs2' =>
|
ezyang@1697
|
64 (case List.last chs1 of
|
ezyang@1697
|
65 String s1 => List.take (chs1, length chs1 - 1) @ String (s1 ^ s2) :: chs2'
|
ezyang@1697
|
66 | _ => chs1 @ chs2)
|
ezyang@1697
|
67 | _ => chs1 @ chs2
|
ezyang@1697
|
68 end
|
ezyang@1697
|
69 | _ => [Exp e]
|
ezyang@1697
|
70
|
ezyang@1697
|
71 type 'a parser = chunk list -> ('a * chunk list) option
|
ezyang@1697
|
72
|
ezyang@1697
|
73 fun always v chs = SOME (v, chs)
|
ezyang@1697
|
74
|
ezyang@1697
|
75 fun parse p s =
|
ezyang@1697
|
76 case p (chunkify s) of
|
ezyang@1697
|
77 SOME (v, []) => SOME v
|
ezyang@1697
|
78 | _ => NONE
|
ezyang@1697
|
79
|
ezyang@1697
|
80 fun const s chs =
|
ezyang@1697
|
81 case chs of
|
ezyang@1697
|
82 String s' :: chs => if String.isPrefix s s' then
|
ezyang@1697
|
83 SOME ((), if size s = size s' then
|
ezyang@1697
|
84 chs
|
ezyang@1697
|
85 else
|
ezyang@1697
|
86 String (String.extract (s', size s, NONE)) :: chs)
|
ezyang@1697
|
87 else
|
ezyang@1697
|
88 NONE
|
ezyang@1697
|
89 | _ => NONE
|
ezyang@1697
|
90
|
ezyang@1697
|
91 fun follow p1 p2 chs =
|
ezyang@1697
|
92 case p1 chs of
|
ezyang@1697
|
93 NONE => NONE
|
ezyang@1697
|
94 | SOME (v1, chs) =>
|
ezyang@1697
|
95 case p2 chs of
|
ezyang@1697
|
96 NONE => NONE
|
ezyang@1697
|
97 | SOME (v2, chs) => SOME ((v1, v2), chs)
|
ezyang@1697
|
98
|
ezyang@1697
|
99 fun wrap p f chs =
|
ezyang@1697
|
100 case p chs of
|
ezyang@1697
|
101 NONE => NONE
|
ezyang@1697
|
102 | SOME (v, chs) => SOME (f v, chs)
|
ezyang@1697
|
103
|
ezyang@1697
|
104 fun wrapP p f chs =
|
ezyang@1697
|
105 case p chs of
|
ezyang@1697
|
106 NONE => NONE
|
ezyang@1697
|
107 | SOME (v, chs) =>
|
ezyang@1697
|
108 case f v of
|
ezyang@1697
|
109 NONE => NONE
|
ezyang@1697
|
110 | SOME r => SOME (r, chs)
|
ezyang@1697
|
111
|
ezyang@1697
|
112 fun alt p1 p2 chs =
|
ezyang@1697
|
113 case p1 chs of
|
ezyang@1697
|
114 NONE => p2 chs
|
ezyang@1697
|
115 | v => v
|
ezyang@1697
|
116
|
ezyang@1697
|
117 fun altL ps =
|
ezyang@1697
|
118 case rev ps of
|
ezyang@1697
|
119 [] => (fn _ => NONE)
|
ezyang@1697
|
120 | p :: ps =>
|
ezyang@1697
|
121 foldl (fn (p1, p2) => alt p1 p2) p ps
|
ezyang@1697
|
122
|
ezyang@1697
|
123 fun opt p chs =
|
ezyang@1697
|
124 case p chs of
|
ezyang@1697
|
125 NONE => SOME (NONE, chs)
|
ezyang@1697
|
126 | SOME (v, chs) => SOME (SOME v, chs)
|
ezyang@1697
|
127
|
ezyang@1697
|
128 fun skip cp chs =
|
ezyang@1697
|
129 case chs of
|
ezyang@1697
|
130 String "" :: chs => skip cp chs
|
ezyang@1697
|
131 | String s :: chs' => if cp (String.sub (s, 0)) then
|
ezyang@1697
|
132 skip cp (String (String.extract (s, 1, NONE)) :: chs')
|
ezyang@1697
|
133 else
|
ezyang@1697
|
134 SOME ((), chs)
|
ezyang@1697
|
135 | _ => SOME ((), chs)
|
ezyang@1697
|
136
|
ezyang@1697
|
137 fun keep cp chs =
|
ezyang@1697
|
138 case chs of
|
ezyang@1697
|
139 String "" :: chs => keep cp chs
|
ezyang@1697
|
140 | String s :: chs' =>
|
ezyang@1697
|
141 let
|
ezyang@1697
|
142 val (befor, after) = Substring.splitl cp (Substring.full s)
|
ezyang@1697
|
143 in
|
ezyang@1697
|
144 if Substring.isEmpty befor then
|
ezyang@1697
|
145 NONE
|
ezyang@1697
|
146 else
|
ezyang@1697
|
147 SOME (Substring.string befor,
|
ezyang@1697
|
148 if Substring.isEmpty after then
|
ezyang@1697
|
149 chs'
|
ezyang@1697
|
150 else
|
ezyang@1697
|
151 String (Substring.string after) :: chs')
|
ezyang@1697
|
152 end
|
ezyang@1697
|
153 | _ => NONE
|
ezyang@1697
|
154
|
ziv@2238
|
155 (* Used by primSqlcache. *)
|
ziv@2238
|
156 fun optConst s chs =
|
ziv@2238
|
157 case chs of
|
ziv@2238
|
158 String s' :: chs => if String.isPrefix s s' then
|
ziv@2238
|
159 SOME (s, if size s = size s' then
|
ziv@2238
|
160 chs
|
ziv@2238
|
161 else
|
ziv@2238
|
162 String (String.extract (s', size s, NONE)) :: chs)
|
ziv@2238
|
163 else
|
ziv@2238
|
164 SOME ("", String s' :: chs)
|
ziv@2238
|
165 | _ => NONE
|
ziv@2238
|
166
|
ezyang@1697
|
167 fun ws p = wrap (follow (skip (fn ch => ch = #" "))
|
ezyang@1697
|
168 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
|
ezyang@1697
|
169
|
ezyang@1697
|
170 fun log name p chs =
|
ezyang@1697
|
171 (if !debug then
|
ezyang@1697
|
172 (print (name ^ ": ");
|
ezyang@1697
|
173 app (fn String s => print s
|
ezyang@1697
|
174 | _ => print "???") chs;
|
ezyang@1697
|
175 print "\n")
|
ezyang@1697
|
176 else
|
ezyang@1697
|
177 ();
|
ezyang@1697
|
178 p chs)
|
ezyang@1697
|
179
|
ezyang@1697
|
180 fun list p chs =
|
ezyang@1697
|
181 altL [wrap (follow p (follow (ws (const ",")) (list p)))
|
ezyang@1697
|
182 (fn (v, ((), ls)) => v :: ls),
|
ezyang@1697
|
183 wrap (ws p) (fn v => [v]),
|
ezyang@1697
|
184 always []] chs
|
ezyang@1697
|
185
|
ezyang@1697
|
186 val ident = keep (fn ch => Char.isAlphaNum ch orelse ch = #"_")
|
ezyang@1697
|
187
|
ezyang@1697
|
188 val t_ident = wrapP ident (fn s => if String.isPrefix "T_" s then
|
ezyang@1697
|
189 SOME (String.extract (s, 2, NONE))
|
ezyang@1697
|
190 else
|
ezyang@1697
|
191 NONE)
|
ezyang@1697
|
192 val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >= 4 then
|
ezyang@1697
|
193 SOME (str (Char.toUpper (String.sub (s, 3)))
|
ezyang@1697
|
194 ^ String.extract (s, 4, NONE))
|
ezyang@1697
|
195 else
|
ezyang@1697
|
196 NONE)
|
ezyang@1697
|
197
|
ziv@2209
|
198 val field = wrap (follow (opt (follow t_ident (const ".")))
|
ziv@2209
|
199 uw_ident)
|
ziv@2209
|
200 (fn (SOME (t, ()), f) => (t, f)
|
ziv@2209
|
201 | (NONE, f) => ("T", f)) (* Should probably deal with this MySQL/SQLite case better some day. *)
|
ezyang@1697
|
202
|
ezyang@1697
|
203 datatype Rel =
|
ziv@2216
|
204 RCmp of cmp
|
ziv@2216
|
205 | RLop of lop
|
ezyang@1697
|
206
|
ezyang@1697
|
207 datatype sqexp =
|
ezyang@1697
|
208 SqConst of Prim.t
|
ezyang@1697
|
209 | SqTrue
|
ezyang@1697
|
210 | SqFalse
|
ezyang@1697
|
211 | SqNot of sqexp
|
ezyang@1697
|
212 | Field of string * string
|
ezyang@1697
|
213 | Computed of string
|
ezyang@1697
|
214 | Binop of Rel * sqexp * sqexp
|
ezyang@1697
|
215 | SqKnown of sqexp
|
ezyang@1697
|
216 | Inj of Mono.exp
|
ezyang@1697
|
217 | SqFunc of string * sqexp
|
ezyang@1697
|
218 | Unmodeled
|
ezyang@1697
|
219 | Null
|
ezyang@1697
|
220
|
ziv@2216
|
221 fun cmp s r = wrap (const s) (fn () => RCmp r)
|
ezyang@1697
|
222
|
ezyang@1697
|
223 val sqbrel = altL [cmp "=" Eq,
|
ezyang@1697
|
224 cmp "<>" Ne,
|
ezyang@1697
|
225 cmp "<=" Le,
|
ezyang@1697
|
226 cmp "<" Lt,
|
ezyang@1697
|
227 cmp ">=" Ge,
|
ezyang@1697
|
228 cmp ">" Gt,
|
ziv@2235
|
229 wrap (const "AND") (fn () => RLop And),
|
ziv@2235
|
230 wrap (const "OR") (fn () => RLop Or)]
|
ezyang@1697
|
231
|
ezyang@1697
|
232 datatype ('a, 'b) sum = inl of 'a | inr of 'b
|
ezyang@1697
|
233
|
ezyang@1697
|
234 fun string chs =
|
ezyang@1697
|
235 case chs of
|
ezyang@1697
|
236 String s :: chs =>
|
ezyang@1697
|
237 if size s >= 2 andalso String.sub (s, 0) = #"'" then
|
ezyang@1697
|
238 let
|
ezyang@1697
|
239 fun loop (cs, acc) =
|
ezyang@1697
|
240 case cs of
|
ezyang@1697
|
241 [] => NONE
|
ezyang@1697
|
242 | c :: cs =>
|
ezyang@1697
|
243 if c = #"'" then
|
ezyang@1697
|
244 SOME (String.implode (rev acc), cs)
|
ezyang@1697
|
245 else if c = #"\\" then
|
ezyang@1697
|
246 case cs of
|
ezyang@1697
|
247 c :: cs => loop (cs, c :: acc)
|
ezyang@1697
|
248 | _ => raise Fail "Iflow.string: Unmatched backslash escape"
|
ezyang@1697
|
249 else
|
ezyang@1697
|
250 loop (cs, c :: acc)
|
ezyang@1697
|
251 in
|
ezyang@1697
|
252 case loop (String.explode (String.extract (s, 1, NONE)), []) of
|
ezyang@1697
|
253 NONE => NONE
|
ezyang@1697
|
254 | SOME (s, []) => SOME (s, chs)
|
ezyang@1697
|
255 | SOME (s, cs) => SOME (s, String (String.implode cs) :: chs)
|
ezyang@1697
|
256 end
|
ezyang@1697
|
257 else
|
ezyang@1697
|
258 NONE
|
ziv@2202
|
259 | _ => NONE
|
ezyang@1697
|
260
|
ezyang@1697
|
261 val prim =
|
ezyang@1697
|
262 altL [wrap (follow (wrapP (follow (keep Char.isDigit) (follow (const ".") (keep Char.isDigit)))
|
ezyang@1697
|
263 (fn (x, ((), y)) => Option.map Prim.Float (Real64.fromString (x ^ "." ^ y))))
|
ezyang@1697
|
264 (opt (const "::float8"))) #1,
|
ezyang@1697
|
265 wrap (follow (wrapP (keep Char.isDigit)
|
ezyang@1697
|
266 (Option.map Prim.Int o Int64.fromString))
|
ezyang@1697
|
267 (opt (const "::int8"))) #1,
|
ezyang@1697
|
268 wrap (follow (opt (const "E")) (follow string (opt (const "::text"))))
|
adam@2048
|
269 ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)]
|
ezyang@1697
|
270
|
ziv@2238
|
271 val primSqlcache =
|
ziv@2238
|
272 (* Like [prim], but always uses [Prim.String]s. *)
|
ziv@2238
|
273 let
|
ziv@2238
|
274 fun wrapS p f = wrap p ((fn s => Prim.String (Prim.Normal, s)) o f)
|
ziv@2238
|
275 in
|
ziv@2238
|
276 altL [wrapS (follow (wrap (follow (keep Char.isDigit)
|
ziv@2238
|
277 (follow (const ".") (keep Char.isDigit)))
|
ziv@2238
|
278 (fn (x, ((), y)) => x ^ "." ^ y))
|
ziv@2238
|
279 (optConst "::float8"))
|
ziv@2238
|
280 op^,
|
ziv@2238
|
281 wrapS (follow (keep Char.isDigit)
|
ziv@2238
|
282 (optConst "::int8"))
|
ziv@2238
|
283 op^,
|
ziv@2238
|
284 wrapS (follow (optConst "E") (follow string (optConst "::text")))
|
ziv@2238
|
285 (fn (c1, (s, c2)) => c1 ^ s ^ c2)]
|
ziv@2238
|
286 end
|
ziv@2238
|
287
|
ezyang@1697
|
288 fun known' chs =
|
ezyang@1697
|
289 case chs of
|
ezyang@1697
|
290 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs)
|
ezyang@1697
|
291 | _ => NONE
|
ezyang@1697
|
292
|
ezyang@1697
|
293 fun sqlify chs =
|
ezyang@1697
|
294 case chs of
|
ezyang@1697
|
295 Exp (EFfiApp ("Basis", f, [(e, _)]), _) :: chs =>
|
ezyang@1697
|
296 if String.isPrefix "sqlify" f then
|
ezyang@1697
|
297 SOME (e, chs)
|
ezyang@1697
|
298 else
|
ezyang@1697
|
299 NONE
|
ezyang@1697
|
300 | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
|
adam@2048
|
301 (EPrim (Prim.String (Prim.Normal, "TRUE")), _)),
|
ezyang@1697
|
302 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
|
adam@2048
|
303 (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs =>
|
ezyang@1697
|
304 SOME (e, chs)
|
ziv@2202
|
305
|
ezyang@1697
|
306 | _ => NONE
|
ezyang@1697
|
307
|
ziv@2245
|
308 (* For sqlcache, we only care that we can do string equality on injected Mono
|
ziv@2245
|
309 expressions, so accept any expression without modifying it. *)
|
ziv@2245
|
310 val sqlifySqlcache =
|
ziv@2245
|
311 fn Exp e :: chs => SOME (e, chs)
|
ziv@2247
|
312 | _ => NONE
|
ziv@2213
|
313
|
ezyang@1697
|
314 fun constK s = wrap (const s) (fn () => s)
|
ezyang@1697
|
315
|
ezyang@1697
|
316 val funcName = altL [constK "COUNT",
|
ezyang@1697
|
317 constK "MIN",
|
ezyang@1697
|
318 constK "MAX",
|
ezyang@1697
|
319 constK "SUM",
|
ezyang@1697
|
320 constK "AVG"]
|
ezyang@1697
|
321
|
ziv@2239
|
322 fun arithmetic pExp = follow (const "(")
|
ziv@2239
|
323 (follow pExp
|
ziv@2239
|
324 (follow (altL (map const [" + ", " - ", " * ", " / "]))
|
ziv@2239
|
325 (follow pExp (const ")"))))
|
ziv@2239
|
326
|
ezyang@1697
|
327 val unmodeled = altL [const "COUNT(*)",
|
ezyang@1697
|
328 const "CURRENT_TIMESTAMP"]
|
ezyang@1697
|
329
|
ziv@2213
|
330 val sqlcacheMode = ref false;
|
ziv@2213
|
331
|
ezyang@1697
|
332 fun sqexp chs =
|
ezyang@1697
|
333 log "sqexp"
|
ziv@2238
|
334 (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
|
ezyang@1697
|
335 wrap (const "TRUE") (fn () => SqTrue),
|
ezyang@1697
|
336 wrap (const "FALSE") (fn () => SqFalse),
|
ezyang@1697
|
337 wrap (const "NULL") (fn () => Null),
|
ezyang@1697
|
338 wrap field Field,
|
ezyang@1697
|
339 wrap uw_ident Computed,
|
ezyang@1697
|
340 wrap known SqKnown,
|
ezyang@1697
|
341 wrap func SqFunc,
|
ziv@2239
|
342 wrap (arithmetic sqexp) (fn _ => Unmodeled),
|
ezyang@1697
|
343 wrap unmodeled (fn () => Unmodeled),
|
ziv@2213
|
344 wrap (if !sqlcacheMode then sqlifySqlcache else sqlify) Inj,
|
ezyang@1697
|
345 wrap (follow (const "COALESCE(") (follow sqexp (follow (const ",")
|
ezyang@1697
|
346 (follow (keep (fn ch => ch <> #")")) (const ")")))))
|
ezyang@1697
|
347 (fn ((), (e, _)) => e),
|
ezyang@1697
|
348 wrap (follow (const "(NOT ") (follow sqexp (const ")")))
|
ezyang@1697
|
349 (fn ((), (e, _)) => SqNot e),
|
ezyang@1697
|
350 wrap (follow (ws (const "("))
|
ezyang@1697
|
351 (follow (wrap
|
ezyang@1697
|
352 (follow sqexp
|
ezyang@1697
|
353 (alt
|
ezyang@1697
|
354 (wrap
|
ezyang@1697
|
355 (follow (ws sqbrel)
|
ezyang@1697
|
356 (ws sqexp))
|
ezyang@1697
|
357 inl)
|
ezyang@1697
|
358 (always (inr ()))))
|
ezyang@1697
|
359 (fn (e1, sm) =>
|
ezyang@1697
|
360 case sm of
|
ezyang@1697
|
361 inl (bo, e2) => Binop (bo, e1, e2)
|
ezyang@1697
|
362 | inr () => e1))
|
ezyang@1697
|
363 (const ")")))
|
ezyang@1697
|
364 (fn ((), (e, ())) => e)])
|
ezyang@1697
|
365 chs
|
ezyang@1697
|
366
|
ezyang@1697
|
367 and known chs = wrap (follow known' (follow (const "(") (follow sqexp (const ")"))))
|
ezyang@1697
|
368 (fn ((), ((), (e, ()))) => e) chs
|
ziv@2202
|
369
|
ezyang@1697
|
370 and func chs = wrap (follow funcName (follow (const "(") (follow sqexp (const ")"))))
|
ezyang@1697
|
371 (fn (f, ((), (e, ()))) => (f, e)) chs
|
ezyang@1697
|
372
|
ezyang@1697
|
373 datatype sitem =
|
ezyang@1697
|
374 SqField of string * string
|
ezyang@1697
|
375 | SqExp of sqexp * string
|
ezyang@1697
|
376
|
ezyang@1697
|
377 val sitem = alt (wrap (follow sqexp (follow (const " AS ") uw_ident))
|
ezyang@1697
|
378 (fn (e, ((), s)) => SqExp (e, s)))
|
ezyang@1697
|
379 (wrap field SqField)
|
ezyang@1697
|
380
|
ezyang@1697
|
381 val select = log "select"
|
ezyang@1697
|
382 (wrap (follow (const "SELECT ") (list sitem))
|
ezyang@1697
|
383 (fn ((), ls) => ls))
|
ezyang@1697
|
384
|
ezyang@1697
|
385 val fitem = wrap (follow uw_ident
|
ezyang@1697
|
386 (follow (const " AS ")
|
ezyang@1697
|
387 t_ident))
|
ezyang@1697
|
388 (fn (t, ((), f)) => (t, f))
|
ezyang@1697
|
389
|
ezyang@1697
|
390 val from = log "from"
|
ezyang@1697
|
391 (wrap (follow (const "FROM ") (list fitem))
|
ezyang@1697
|
392 (fn ((), ls) => ls))
|
ezyang@1697
|
393
|
ezyang@1697
|
394 val wher = wrap (follow (ws (const "WHERE ")) sqexp)
|
ezyang@1697
|
395 (fn ((), ls) => ls)
|
ezyang@1697
|
396
|
ezyang@1697
|
397 type query1 = {Select : sitem list,
|
ezyang@1697
|
398 From : (string * string) list,
|
ezyang@1697
|
399 Where : sqexp option}
|
ezyang@1697
|
400
|
ezyang@1697
|
401 val query1 = log "query1"
|
ezyang@1697
|
402 (wrap (follow (follow select from) (opt wher))
|
ezyang@1697
|
403 (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher}))
|
ezyang@1697
|
404
|
ezyang@1697
|
405 datatype query =
|
ezyang@1697
|
406 Query1 of query1
|
ezyang@1697
|
407 | Union of query * query
|
ezyang@1697
|
408
|
ezyang@1697
|
409 val orderby = log "orderby"
|
ezyang@1697
|
410 (wrap (follow (ws (const "ORDER BY "))
|
ezyang@1697
|
411 (follow (list sqexp)
|
ezyang@1697
|
412 (opt (ws (const "DESC")))))
|
ezyang@1697
|
413 ignore)
|
ezyang@1697
|
414
|
ezyang@1697
|
415 fun query chs = log "query"
|
ezyang@1697
|
416 (wrap
|
ezyang@1697
|
417 (follow
|
ezyang@1697
|
418 (alt (wrap (follow (const "((")
|
ezyang@1697
|
419 (follow query
|
ezyang@1697
|
420 (follow (const ") UNION (")
|
ezyang@1697
|
421 (follow query (const "))")))))
|
ezyang@1697
|
422 (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
|
ezyang@1697
|
423 (wrap query1 Query1))
|
ezyang@1697
|
424 (opt orderby))
|
ezyang@1697
|
425 #1)
|
ezyang@1697
|
426 chs
|
ezyang@1697
|
427
|
ezyang@1697
|
428 datatype dml =
|
ezyang@1697
|
429 Insert of string * (string * sqexp) list
|
ezyang@1697
|
430 | Delete of string * sqexp
|
ezyang@1697
|
431 | Update of string * (string * sqexp) list * sqexp
|
ezyang@1697
|
432
|
ezyang@1697
|
433 val insert = log "insert"
|
ezyang@1697
|
434 (wrapP (follow (const "INSERT INTO ")
|
ezyang@1697
|
435 (follow uw_ident
|
ezyang@1697
|
436 (follow (const " (")
|
ezyang@1697
|
437 (follow (list uw_ident)
|
ezyang@1697
|
438 (follow (const ") VALUES (")
|
ezyang@1697
|
439 (follow (list sqexp)
|
ezyang@1697
|
440 (const ")")))))))
|
ezyang@1697
|
441 (fn ((), (tab, ((), (fs, ((), (es, ())))))) =>
|
ezyang@1697
|
442 (SOME (tab, ListPair.zipEq (fs, es)))
|
ezyang@1697
|
443 handle ListPair.UnequalLengths => NONE))
|
ezyang@1697
|
444
|
ezyang@1697
|
445 val delete = log "delete"
|
ezyang@1697
|
446 (wrap (follow (const "DELETE FROM ")
|
ezyang@1697
|
447 (follow uw_ident
|
ziv@2209
|
448 (follow (follow (opt (const " AS T_T")) (const " WHERE "))
|
ezyang@1697
|
449 sqexp)))
|
ziv@2209
|
450 (fn ((), (tab, (_, es))) => (tab, es)))
|
ezyang@1697
|
451
|
ezyang@1697
|
452 val setting = log "setting"
|
ziv@2209
|
453 (wrap (follow uw_ident (follow (const " = ") sqexp))
|
ziv@2209
|
454 (fn (f, ((), e)) => (f, e)))
|
ezyang@1697
|
455
|
ezyang@1697
|
456 val update = log "update"
|
ezyang@1697
|
457 (wrap (follow (const "UPDATE ")
|
ezyang@1697
|
458 (follow uw_ident
|
ziv@2209
|
459 (follow (follow (opt (const " AS T_T")) (const " SET "))
|
ezyang@1697
|
460 (follow (list setting)
|
ezyang@1697
|
461 (follow (ws (const "WHERE "))
|
ezyang@1697
|
462 sqexp)))))
|
ziv@2209
|
463 (fn ((), (tab, (_, (fs, ((), e))))) =>
|
ezyang@1697
|
464 (tab, fs, e)))
|
ezyang@1697
|
465
|
ezyang@1697
|
466 val dml = log "dml"
|
ezyang@1697
|
467 (altL [wrap insert Insert,
|
ezyang@1697
|
468 wrap delete Delete,
|
ezyang@1697
|
469 wrap update Update])
|
ezyang@1697
|
470
|
ezyang@1697
|
471 datatype querydml =
|
ezyang@1697
|
472 Query of query
|
ezyang@1697
|
473 | Dml of dml
|
ezyang@1697
|
474
|
ezyang@1697
|
475 val querydml = log "querydml" (altL [wrap dml Dml, wrap query Query])
|
ezyang@1697
|
476
|
ezyang@1697
|
477 end
|