summaryrefslogtreecommitdiff
path: root/src
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
commit26648546e656337366f5cf2562fb6bcbe08a06c8 (patch)
treeb8dfbb24caa3bc4cf3cf683e44a9ab92c4dc9e34 /src
parent4ba25b80371081c01dfe165b715c9dece1f95cc5 (diff)
Tweaking SQL parsing and typing
Diffstat (limited to 'src')
-rw-r--r--src/monoize.sml12
-rw-r--r--src/urweb.grm16
2 files changed, 20 insertions, 8 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 0a1990c7..f3c8b5f6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1772,11 +1772,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.ECApp (
(L.ECApp (
(L.ECApp (
- (L.EFfi ("Basis", "sql_query1"), _),
- (L.CRecord (_, tables), _)), _),
- (L.CRecord (_, grouped), _)), _),
- (L.CRecord (_, stables), _)), _),
- sexps) =>
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_query1"), _),
+ (L.CRecord (_, tables), _)), _),
+ (L.CRecord (_, grouped), _)), _),
+ (L.CRecord (_, stables), _)), _),
+ sexps), _),
+ _) =>
let
fun sc s = (L'.EPrim (Prim.String s), loc)
val s = (L'.TFfi ("Basis", "string"), loc)
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