Compiled a window function use

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