summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-06-02 16:00:50 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2012-06-02 16:00:50 -0400
commit8b6941ac380392e36a30a06fb558c47a8fe7d2d8 (patch)
treeda888caf3fa14afe2943de2d9c8c82830c209de1
parentf4dab2b31d11cc6957c1a64a3ffe6261816d96d4 (diff)
Compiled a window function use
-rw-r--r--lib/ur/basis.urs16
-rw-r--r--src/monoize.sml54
-rw-r--r--src/urweb.grm90
-rw-r--r--src/urweb.lex3
-rw-r--r--tests/window.ur11
-rw-r--r--tests/window.urp6
6 files changed, 156 insertions, 24 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 27b6393b..2a4d28cf 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -564,6 +564,22 @@ val sql_maxable_option : t ::: Type -> sql_maxable t -> sql_maxable (option t)
val sql_max : t ::: Type -> nt ::: Type -> sql_maxable t -> nullify t nt -> sql_aggregate t nt
val sql_min : t ::: Type -> nt ::: Type -> sql_maxable t -> nullify t nt -> sql_aggregate t nt
+con sql_window :: {{Type}} -> {{Type}} -> {Type} -> Type -> Type
+val sql_window : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> t ::: Type
+ -> sql_window tables agg exps t
+ -> sql_exp tables agg exps allow_window t
+
+val sql_window_aggregate : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> t ::: Type -> nt ::: Type
+ -> sql_aggregate t nt
+ -> sql_exp tables agg exps allow_window t
+ -> sql_window tables agg exps nt
+val sql_window_count : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> sql_window tables agg exps int
+val sql_window_rank : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
+ -> sql_window tables agg exps int
+
con sql_nfunc :: Type -> Type
val sql_nfunc : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
-> aw ::: {Unit} -> t ::: Type
diff --git a/src/monoize.sml b/src/monoize.sml
index 7fba8c98..1a70894f 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -299,6 +299,8 @@ fun monoType env =
(L'.TRecord [], loc)
| L.CApp ((L.CFfi ("Basis", "sql_maxable"), _), _) =>
(L'.TRecord [], loc)
+ | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_window"), _), _), _), _), _), _), _), _) =>
+ (L'.TFfi ("Basis", "string"), loc)
| L.CApp ((L.CFfi ("Basis", "sql_arith"), _), _) =>
(L'.TRecord [], loc)
| L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) =>
@@ -2728,7 +2730,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
sc ")"]
in
((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
- (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), main), loc)), loc),
+ (L'.EAbs ("e1", s, s, main), loc)), loc),
fm)
end
@@ -2778,6 +2780,56 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.EPrim (Prim.String "MIN"), loc)), loc)), loc),
fm)
+ | L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_window"), _),
+ _), _),
+ _), _),
+ _), _),
+ _) =>
+ let
+ val s = (L'.TFfi ("Basis", "string"), loc)
+ fun sc s = (L'.EPrim (Prim.String s), loc)
+
+ val main = strcat [(L'.ERel 0, loc),
+ sc " OVER ()"]
+ in
+ ((L'.EAbs ("w", s, s, main), loc),
+ fm)
+ end
+
+ | L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.ECApp (
+ (L.EFfi ("Basis", "sql_window_aggregate"), _),
+ _), _),
+ _), _),
+ _), _),
+ _), _),
+ _) =>
+ let
+ val s = (L'.TFfi ("Basis", "string"), loc)
+ fun sc s = (L'.EPrim (Prim.String s), loc)
+
+ val main = strcat [(L'.ERel 1, loc),
+ sc "(",
+ (L'.ERel 0, loc),
+ sc ")"]
+ in
+ ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
+ (L'.EAbs ("e1", s, s, main), loc)), loc),
+ fm)
+ end
+
+ | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_count"), _), _), _), _), _), _) =>
+ ((L'.EPrim (Prim.String "COUNT(*)"), loc), fm)
+ | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_window_rank"), _), _), _), _), _), _) =>
+ ((L'.EPrim (Prim.String "RANK()"), loc), fm)
+
| L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
| L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
| L.ECApp (
diff --git a/src/urweb.grm b/src/urweb.grm
index 1419ef3f..831ec4a8 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -332,7 +332,7 @@ fun parseStyle s pos =
| UNION | INTERSECT | EXCEPT
| LIMIT | OFFSET | ALL
| TRUE | FALSE | CAND | OR | NOT
- | COUNT | AVG | SUM | MIN | MAX
+ | COUNT | AVG | SUM | MIN | MAX | RANK
| ASC | DESC | RANDOM
| INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS | COALESCE | LIKE
| CURRENT_TIMESTAMP
@@ -340,6 +340,7 @@ fun parseStyle s pos =
| CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
| JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
| CIF | CTHEN | CELSE
+ | OVER | PARTITION
%nonterm
file of decl list
@@ -455,6 +456,7 @@ fun parseStyle s pos =
| selis of select_item list
| select of select
| sqlexp of exp
+ | window of unit option
| wopt of exp
| groupi of group_item
| groupis of group_item list
@@ -2025,29 +2027,68 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In
| NULL (sql_inject ((EVar (["Basis"], "None", Infer),
s (NULLleft, NULLright))))
- | COUNT LPAREN STAR RPAREN (let
- val loc = s (COUNTleft, RPARENright)
- in
- (EVar (["Basis"], "sql_count", Infer), loc)
- end)
- | COUNT LPAREN sqlexp RPAREN (let
- val loc = s (COUNTleft, RPARENright)
-
- val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
- val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
- e), loc)
- in
- (EApp (e, sqlexp), loc)
- end)
- | sqlagg LPAREN sqlexp RPAREN (let
- val loc = s (sqlaggleft, RPARENright)
+ | COUNT LPAREN STAR RPAREN window (let
+ val loc = s (COUNTleft, windowright)
+ in
+ case window of
+ NONE => (EVar (["Basis"], "sql_count", Infer), loc)
+ | SOME _ =>
+ let
+ val e = (EVar (["Basis"], "sql_window_count", Infer), loc)
+ in
+ (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc)
+ end
+ end)
+ | RANK UNIT window (let
+ val loc = s (RANKleft, windowright)
+ val e = (EVar (["Basis"], "sql_window_rank", Infer), loc)
+ in
+ (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc)
+ end)
+ | COUNT LPAREN sqlexp RPAREN window (let
+ val loc = s (COUNTleft, windowright)
+
+ val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
+ in
+ case window of
+ NONE =>
+ let
+ val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
+ e), loc)
+ in
+ (EApp (e, sqlexp), loc)
+ end
+ | SOME _ =>
+ let
+ val e = (EApp ((EVar (["Basis"], "sql_window_aggregate", Infer), loc),
+ e), loc)
+ val e = (EApp (e, sqlexp), loc)
+ in
+ (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc)
+ end
+ end)
+ | sqlagg LPAREN sqlexp RPAREN window (let
+ val loc = s (sqlaggleft, windowright)
- val e = (EVar (["Basis"], "sql_" ^ sqlagg, Infer), loc)
- val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
- e), loc)
- in
- (EApp (e, sqlexp), loc)
- end)
+ val e = (EVar (["Basis"], "sql_" ^ sqlagg, Infer), loc)
+ in
+ case window of
+ NONE =>
+ let
+ val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
+ e), loc)
+ in
+ (EApp (e, sqlexp), loc)
+ end
+ | SOME _ =>
+ let
+ val e = (EApp ((EVar (["Basis"], "sql_window_aggregate", Infer), loc),
+ e), loc)
+ val e = (EApp (e, sqlexp), loc)
+ in
+ (EApp ((EVar (["Basis"], "sql_window", Infer), loc), e), loc)
+ end
+ end)
| COALESCE LPAREN sqlexp COMMA sqlexp RPAREN
(let
val loc = s (COALESCEright, sqlexp2right)
@@ -2072,6 +2113,9 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In
(EApp (e, query), loc)
end)
+window : (NONE)
+ | OVER LPAREN RPAREN (SOME ())
+
fname : SYMBOL (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
| LBRACE eexp RBRACE (eexp)
diff --git a/src/urweb.lex b/src/urweb.lex
index 5d3d6dbe..272c5e65 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -463,6 +463,8 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
<INITIAL> "OFFSET" => (Tokens.OFFSET (pos yypos, pos yypos + size yytext));
<INITIAL> "ALL" => (Tokens.ALL (pos yypos, pos yypos + size yytext));
<INITIAL> "SELECT1" => (Tokens.SELECT1 (pos yypos, pos yypos + size yytext));
+<INITIAL> "OVER" => (Tokens.OVER (pos yypos, pos yypos + size yytext));
+<INITIAL> "PARTITION" => (Tokens.PARTITION (pos yypos, pos yypos + size yytext));
<INITIAL> "JOIN" => (Tokens.JOIN (pos yypos, pos yypos + size yytext));
<INITIAL> "INNER" => (Tokens.INNER (pos yypos, pos yypos + size yytext));
@@ -487,6 +489,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
<INITIAL> "SUM" => (Tokens.SUM (pos yypos, pos yypos + size yytext));
<INITIAL> "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext));
<INITIAL> "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext));
+<INITIAL> "RANK" => (Tokens.RANK (pos yypos, pos yypos + size yytext));
<INITIAL> "IF" => (Tokens.CIF (pos yypos, pos yypos + size yytext));
<INITIAL> "THEN" => (Tokens.CTHEN (pos yypos, pos yypos + size yytext));
diff --git a/tests/window.ur b/tests/window.ur
new file mode 100644
index 00000000..fd93679c
--- /dev/null
+++ b/tests/window.ur
@@ -0,0 +1,11 @@
+table empsalary : { Depname : string,
+ Empno : int,
+ Salary : int }
+
+fun main () : transaction page =
+ x <- queryX (SELECT empsalary.Depname, empsalary.Empno, empsalary.Salary, RANK() AS R
+ FROM empsalary)
+ (fn r => <xml>{[r.Empsalary.Depname]}, {[r.Empsalary.Empno]}, {[r.Empsalary.Salary]}, {[r.R]}<br/></xml>);
+ return <xml><body>
+ {x}
+ </body></xml>
diff --git a/tests/window.urp b/tests/window.urp
new file mode 100644
index 00000000..d1fb21a9
--- /dev/null
+++ b/tests/window.urp
@@ -0,0 +1,6 @@
+debug
+database dbname=test
+sql window.sql
+rewrite url Window/*
+
+window