Mercurial > urweb
changeset 1776:8f28c3295148
Compiled a window function use
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 02 Jun 2012 16:00:50 -0400 |
| parents | 6bc2a8cb3a67 |
| children | 59b07fdae1ff |
| files | lib/ur/basis.urs src/monoize.sml src/urweb.grm src/urweb.lex tests/window.ur tests/window.urp |
| diffstat | 6 files changed, 156 insertions(+), 24 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/basis.urs Sat Jun 02 15:35:58 2012 -0400 +++ b/lib/ur/basis.urs Sat Jun 02 16:00:50 2012 -0400 @@ -564,6 +564,22 @@ 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
--- a/src/monoize.sml Sat Jun 02 15:35:58 2012 -0400 +++ b/src/monoize.sml Sat Jun 02 16:00:50 2012 -0400 @@ -299,6 +299,8 @@ (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 @@ 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 @@ (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 (
--- a/src/urweb.grm Sat Jun 02 15:35:58 2012 -0400 +++ b/src/urweb.grm Sat Jun 02 16:00:50 2012 -0400 @@ -332,7 +332,7 @@ | 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 @@ | 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 @@ | 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 @@ | 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) + | 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_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) - - 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 @@ (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)
--- a/src/urweb.lex Sat Jun 02 15:35:58 2012 -0400 +++ b/src/urweb.lex Sat Jun 02 16:00:50 2012 -0400 @@ -463,6 +463,8 @@ <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 @@ <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));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/window.ur Sat Jun 02 16:00:50 2012 -0400 @@ -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>