Mercurial > urweb

annotate src/sql.sml @ 2296:5104e480b3e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix a few C memory bugs
author Adam Chlipala <adam@chlipala.net>
date Thu, 19 Nov 2015 10:31:47 -0500
parents e6c5bb62fef8
children
rev   line source
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@2261 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
ziv@2294 385 datatype jtype = Inner | Left | Right | Full
ezyang@1697 386
ziv@2294 387 datatype fitem =
ziv@2294 388 Table of string * string (* table AS name *)
ziv@2294 389 | Join of jtype * fitem * fitem * sqexp
ziv@2294 390 | Nested of query * string (* query AS name *)
ziv@2294 391
ziv@2294 392 and query =
ziv@2294 393 Query1 of {Select : sitem list, From : fitem list, Where : sqexp option}
ziv@2294 394 | Union of query * query
ezyang@1697 395
ezyang@1697 396 val wher = wrap (follow (ws (const "WHERE ")) sqexp)
ezyang@1697 397 (fn ((), ls) => ls)
ezyang@1697 398
ezyang@1697 399 val orderby = log "orderby"
ezyang@1697 400 (wrap (follow (ws (const "ORDER BY "))
ziv@2295 401 (list (follow sqexp
ziv@2295 402 (opt (ws (const "DESC"))))))
ezyang@1697 403 ignore)
ezyang@1697 404
ziv@2295 405 val jtype = altL [wrap (const "JOIN") (fn () => Inner),
ziv@2295 406 wrap (const "LEFT JOIN") (fn () => Left),
ziv@2295 407 wrap (const "RIGHT JOIN") (fn () => Right),
ziv@2295 408 wrap (const "FULL JOIN") (fn () => Full)]
ziv@2295 409
ziv@2294 410 fun fitem chs = altL [wrap (follow uw_ident
ziv@2294 411 (follow (const " AS ")
ziv@2294 412 t_ident))
ziv@2294 413 (fn (t, ((), f)) => Table (t, f)),
ziv@2294 414 wrap (follow (const "(")
ziv@2294 415 (follow fitem
ziv@2295 416 (follow (ws jtype)
ziv@2294 417 (follow fitem
ziv@2294 418 (follow (const " ON ")
ziv@2294 419 (follow sqexp
ziv@2294 420 (const ")")))))))
ziv@2294 421 (fn ((), (fi1, (jt, (fi2, ((), (se, ())))))) =>
ziv@2294 422 Join (jt, fi1, fi2, se)),
ziv@2294 423 wrap (follow (const "(")
ziv@2294 424 (follow query
ziv@2294 425 (follow (const ") AS ") t_ident)))
ziv@2294 426 (fn ((), (q, ((), f))) => Nested (q, f))]
ziv@2294 427 chs
ziv@2294 428
ziv@2294 429 and query1 chs = log "query1"
ziv@2294 430 (wrap (follow (follow select from) (opt wher))
ziv@2294 431 (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher}))
ziv@2294 432 chs
ziv@2294 433
ziv@2294 434 and from chs = log "from"
ziv@2294 435 (wrap (follow (const "FROM ") (list fitem))
ziv@2294 436 (fn ((), ls) => ls))
ziv@2294 437 chs
ziv@2294 438
ziv@2294 439 and query chs = log "query"
ziv@2294 440 (wrap (follow
ziv@2294 441 (alt (wrap (follow (const "((")
ziv@2294 442 (follow query
ziv@2294 443 (follow (const ") UNION (")
ziv@2294 444 (follow query (const "))")))))
ziv@2294 445 (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
ziv@2294 446 (wrap query1 Query1))
ziv@2294 447 (opt orderby))
ziv@2294 448 #1)
ziv@2294 449 chs
ezyang@1697 450
ezyang@1697 451 datatype dml =
ezyang@1697 452 Insert of string * (string * sqexp) list
ezyang@1697 453 | Delete of string * sqexp
ezyang@1697 454 | Update of string * (string * sqexp) list * sqexp
ezyang@1697 455
ezyang@1697 456 val insert = log "insert"
ezyang@1697 457 (wrapP (follow (const "INSERT INTO ")
ezyang@1697 458 (follow uw_ident
ezyang@1697 459 (follow (const " (")
ezyang@1697 460 (follow (list uw_ident)
ezyang@1697 461 (follow (const ") VALUES (")
ezyang@1697 462 (follow (list sqexp)
ezyang@1697 463 (const ")")))))))
ezyang@1697 464 (fn ((), (tab, ((), (fs, ((), (es, ())))))) =>
ezyang@1697 465 (SOME (tab, ListPair.zipEq (fs, es)))
ezyang@1697 466 handle ListPair.UnequalLengths => NONE))
ezyang@1697 467
ezyang@1697 468 val delete = log "delete"
ezyang@1697 469 (wrap (follow (const "DELETE FROM ")
ezyang@1697 470 (follow uw_ident
ziv@2261 471 (follow (opt (const " AS T_T"))
ziv@2261 472 (opt (follow (const " WHERE ") sqexp)))))
ziv@2261 473 (fn ((), (tab, (_, wher))) => (tab, case wher of
ziv@2261 474 SOME (_, es) => es
ziv@2261 475 | NONE => SqTrue)))
ezyang@1697 476
ezyang@1697 477 val setting = log "setting"
ziv@2209 478 (wrap (follow uw_ident (follow (const " = ") sqexp))
ziv@2209 479 (fn (f, ((), e)) => (f, e)))
ezyang@1697 480
ezyang@1697 481 val update = log "update"
ezyang@1697 482 (wrap (follow (const "UPDATE ")
ezyang@1697 483 (follow uw_ident
ziv@2209 484 (follow (follow (opt (const " AS T_T")) (const " SET "))
ezyang@1697 485 (follow (list setting)
ezyang@1697 486 (follow (ws (const "WHERE "))
ezyang@1697 487 sqexp)))))
ziv@2209 488 (fn ((), (tab, (_, (fs, ((), e))))) =>
ezyang@1697 489 (tab, fs, e)))
ezyang@1697 490
ezyang@1697 491 val dml = log "dml"
ezyang@1697 492 (altL [wrap insert Insert,
ezyang@1697 493 wrap delete Delete,
ezyang@1697 494 wrap update Update])
ezyang@1697 495
ezyang@1697 496 datatype querydml =
ezyang@1697 497 Query of query
ezyang@1697 498 | Dml of dml
ezyang@1697 499
ezyang@1697 500 val querydml = log "querydml" (altL [wrap dml Dml, wrap query Query])
ezyang@1697 501
ezyang@1697 502 end