summaryrefslogtreecommitdiff
path: root/src/urweb.grm
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 10:13:06 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 10:13:06 -0500
commite376aee8f22ca46b5536803fc3d80e31f79da6ff (patch)
treeb8dfbb24caa3bc4cf3cf683e44a9ab92c4dc9e34 /src/urweb.grm
parent0a168e5f39165bd9e462813866c9a25dc2d6b688 (diff)
Tweaking SQL parsing and typing
Diffstat (limited to 'src/urweb.grm')
-rw-r--r--src/urweb.grm16
1 files changed, 13 insertions, 3 deletions
diff --git a/src/urweb.grm b/src/urweb.grm
index 2251dde7..da40945a 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1169,6 +1169,7 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
| LPAREN query RPAREN (query)
| LPAREN CWHERE sqlexp RPAREN (sqlexp)
| LPAREN SQL sqlexp RPAREN (sqlexp)
+ | LPAREN FROM tables RPAREN (#2 tables)
| LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
(let
@@ -1449,9 +1450,10 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
(let
val loc = s (SELECTleft, tablesright)
- val (sel, exps) =
+ val (empties, sel, exps) =
case select of
- Star => (map (fn nm =>
+ Star => ([],
+ map (fn nm =>
(nm, (CTuple [(CWild (KRecord (KType, loc), loc),
loc),
(CRecord [], loc)],
@@ -1461,8 +1463,12 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
let
val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
+ val empties = List.mapPartial (fn (nm, (CRecord [], _)) =>
+ SOME nm
+ | _ => NONE) tabs
in
- (map (fn (nm, c) => (nm,
+ (empties,
+ map (fn (nm, c) => (nm,
(CTuple [c,
(CWild (KRecord (KType, loc), loc),
loc)], loc))) tabs,
@@ -1494,6 +1500,9 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
end
val e = (EVar (["Basis"], "sql_query1", Infer), loc)
+ val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
+ loc)), loc)
+ val e = (EDisjointApp e, loc)
val re = (ERecord [((CName "Distinct", loc),
dopt),
((CName "From", loc),
@@ -1517,6 +1526,7 @@ query1 : SELECT dopt select FROM tables wopt gopt hopt
| query1 UNION query1 (sql_relop ("union", query11, query12, s (query11left, query12right)))
| query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
| query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right)))
+ | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
tables : fitem (fitem)
| fitem COMMA tables (let