diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2010-03-25 16:06:04 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2010-03-25 16:06:04 -0400 |
| commit | 1cf8f27e444433cd052c0e84f6519288d182d8a7 (patch) | |
| tree | 692542b44d3c974920be5c1b7b9c8a708c336dff | |
| parent | 26eeffeaee9f015cc95430da2f5308ce585a194d (diff) | |
Subquery FROM items
| -rw-r--r-- | lib/ur/basis.urs | 3 | ||||
| -rw-r--r-- | src/monoize.sml | 17 | ||||
| -rw-r--r-- | src/urweb.grm | 8 | ||||
| -rw-r--r-- | tests/subquery.ur | 13 |
4 files changed, 37 insertions, 4 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 98390555..c75eea1b 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -295,6 +295,9 @@ con sql_from_items :: {{Type}} -> {{Type}} -> Type val sql_from_table : free ::: {{Type}} -> t ::: Type -> fs ::: {Type} -> fieldsOf t fs -> name :: Name -> t -> sql_from_items free [name = fs] +val sql_from_query : free ::: {{Type}} -> fs ::: {Type} -> name :: Name + -> sql_query free [] fs + -> sql_from_items free [name = fs] val sql_from_comma : free ::: {{Type}} -> tabs1 ::: {{Type}} -> tabs2 ::: {{Type}} -> [tabs1 ~ tabs2] => sql_from_items free tabs1 -> sql_from_items free tabs2 diff --git a/src/monoize.sml b/src/monoize.sml index 9e5e1b38..5aebad63 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1882,7 +1882,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = strcatComma (map (fn (x, t) => strcat [ (L'.EField (gf "SelectExps", x), loc), - sc (" AS _" ^ x) + sc (" AS uw_" ^ x) ]) sexps @ map (fn (x, xts) => strcatComma @@ -2059,6 +2059,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EPrim (Prim.String (" AS T_" ^ name)), loc)]), loc), fm) end + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_query"), _), _), + _), _), _), + (L.CName name, _)) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + in + ((L'.EAbs ("q", s, s, + strcat [sc "(", + (L'.ERel 0, loc), + sc (") AS T_" ^ name)]), loc), + fm) + end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _), _), _) => let val s = (L'.TFfi ("Basis", "string"), loc) @@ -2317,7 +2330,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _), _), _), _), _), _), - (L.CName nm, _)) => ((L'.EPrim (Prim.String ("_" ^ lowercaseFirst nm)), loc), fm) + (L.CName nm, _)) => ((L'.EPrim (Prim.String ("uw_" ^ lowercaseFirst nm)), loc), fm) | L.ECApp ( (L.ECApp ( diff --git a/src/urweb.grm b/src/urweb.grm index f11c3cd5..995d4664 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -1629,6 +1629,14 @@ fitem : table' ([#1 table'], #2 table') (#1 fitem1 @ #1 fitem2, (EApp (e, sqlexp), loc)) end) + | LPAREN query RPAREN AS tname (let + val loc = s (LPARENleft, RPARENright) + + val e = (EVar (["Basis"], "sql_from_query", Infer), loc) + val e = (ECApp (e, tname), loc) + in + ([tname], (EApp (e, query), loc)) + end) tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) | LBRACE cexp RBRACE (cexp) diff --git a/tests/subquery.ur b/tests/subquery.ur index 302175e5..b7881817 100644 --- a/tests/subquery.ur +++ b/tests/subquery.ur @@ -6,5 +6,14 @@ fun main () = WHERE t.B = (SELECT MAX(U.B) AS M FROM t AS U WHERE U.A = t.A)) - (fn r => <xml>{[r.A]},{[r.C]};</xml>); - return <xml>{v}</xml> + (fn r => <xml>{[r.A]},{[r.C]};</xml>); + v' <- queryX1 (SELECT t.A, t.C + FROM (SELECT t.A AS A, MAX(t.B) AS B + FROM t + GROUP BY t.A) AS Maxes + JOIN t ON t.A = Maxes.A AND t.B = Maxes.B) + (fn r => <xml>{[r.A]},{[r.C]};</xml>); + return <xml><body> + {v}<br/> + {v'} + </body></xml> |