From 8b6941ac380392e36a30a06fb558c47a8fe7d2d8 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 2 Jun 2012 16:00:50 -0400 Subject: Compiled a window function use --- src/monoize.sml | 54 +++++++++++++++++++++++++++++++++- src/urweb.grm | 90 ++++++++++++++++++++++++++++++++++++++++++--------------- src/urweb.lex | 3 ++ 3 files changed, 123 insertions(+), 24 deletions(-) (limited to 'src') 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]; "OFFSET" => (Tokens.OFFSET (pos yypos, pos yypos + size yytext)); "ALL" => (Tokens.ALL (pos yypos, pos yypos + size yytext)); "SELECT1" => (Tokens.SELECT1 (pos yypos, pos yypos + size yytext)); + "OVER" => (Tokens.OVER (pos yypos, pos yypos + size yytext)); + "PARTITION" => (Tokens.PARTITION (pos yypos, pos yypos + size yytext)); "JOIN" => (Tokens.JOIN (pos yypos, pos yypos + size yytext)); "INNER" => (Tokens.INNER (pos yypos, pos yypos + size yytext)); @@ -487,6 +489,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F]; "SUM" => (Tokens.SUM (pos yypos, pos yypos + size yytext)); "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext)); "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext)); + "RANK" => (Tokens.RANK (pos yypos, pos yypos + size yytext)); "IF" => (Tokens.CIF (pos yypos, pos yypos + size yytext)); "THEN" => (Tokens.CTHEN (pos yypos, pos yypos + size yytext)); -- cgit v1.2.3