Basic GROUP BY

3 files changed, 68 insertions, 5 deletions

diff --git a/src/lacweb.grm b/src/lacweb.grm
index d369e179..c9fe7a6c 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -46,6 +46,9 @@ datatype select =
          Star
        | Items of select_item list
 
+datatype group_item =
+         GField of con * con
+
 fun eqTnames ((c1, _), (c2, _)) =
     case (c1, c2) of
         (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
@@ -72,6 +75,26 @@ fun amend_select loc (si, tabs) =
         tabs
     end
 
+fun amend_group loc (gi, tabs) =
+    let
+        val (tx, c) = case gi of
+                          GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
+
+        val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
+                                                  if eqTnames (tx, tx') then
+                                                      ((tx', (CConcat (c, c'), loc)), true)
+                                                  else
+                                                      ((tx', c'), found))
+                            false tabs
+    in
+        if found then
+            ()
+        else
+            ErrorMsg.errorAt loc "Select of field from unbound table";
+
+        tabs
+    end
+
 fun sql_inject (v, t, loc) =
     let
         val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (v, loc)), loc)
@@ -129,7 +152,7 @@ fun sql_unary (oper, sqlexp, loc) =
  | NOTAGS of string 
  | BEGIN_TAG of string | END_TAG of string
 
- | SELECT | FROM | AS | CWHERE
+ | SELECT | FROM | AS | CWHERE | GROUP | BY
  | TRUE | FALSE | CAND | OR | NOT
  | NE | LT | LE | GT | GE
 
@@ -194,6 +217,7 @@ fun sql_unary (oper, sqlexp, loc) =
  | attrv of exp
 
  | query of exp
+ | query1 of exp
  | tables of (con * exp) list
  | tname of con
  | table of con * exp
@@ -204,6 +228,9 @@ fun sql_unary (oper, sqlexp, loc) =
  | select of select
  | sqlexp of exp
  | wopt of exp
+ | groupi of group_item
+ | groupis of group_item list
+ | gopt of group_item list option
 
 
 %verbose                                (* print summary of errors *)
@@ -615,8 +642,10 @@ attrv  : INT                            (EPrim (Prim.Int INT), s (INTleft, INTri
        | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
        | STRING                         (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
        | LBRACE eexp RBRACE             (eexp)
+
+query  : query1                         (query1)
                 
-query  : SELECT select FROM tables wopt
+query1 : SELECT select FROM tables wopt gopt
                                         (let
                                              val loc = s (SELECTleft, tablesright)
 
@@ -640,6 +669,27 @@ query  : SELECT select FROM tables wopt
 
                                              val sel = (CRecord sel, loc)
 
+                                             val grp = case gopt of
+                                                           NONE => (ECApp ((EVar (["Basis"], "sql_subset_all"), loc),
+                                                                           (CWild (KRecord (KRecord (KType, loc), loc),
+                                                                                   loc), loc)), loc)
+                                                         | SOME gis =>
+                                                           let
+                                                               val tabs = map (fn (nm, _) =>
+                                                                                  (nm, (CRecord [], loc))) tables
+                                                               val tabs = foldl (amend_group loc) tabs gis
+
+                                                               val tabs = map (fn (nm, c) =>
+                                                                                  (nm,
+                                                                                   (CTuple [c,
+                                                                                            (CWild (KRecord (KType, loc),
+                                                                                                    loc),
+                                                                                             loc)], loc))) tabs
+                                                           in
+                                                               (ECApp ((EVar (["Basis"], "sql_subset"), loc),
+                                                                       (CRecord tabs, loc)), loc)
+                                                           end
+
                                              val hopt = (sql_inject (EVar (["Basis"], "True"),
                                                                      EVar (["Basis"], "sql_bool"),
                                                                      loc))
@@ -650,9 +700,7 @@ query  : SELECT select FROM tables wopt
                                                                 ((CName "Where", loc),
                                                                  wopt),
                                                                 ((CName "GroupBy", loc),
-                                                                 (ECApp ((EVar (["Basis"], "sql_subset_all"), loc),
-                                                                         (CWild (KRecord (KRecord (KType, loc), loc),
-                                                                                 loc), loc)), loc)),
+                                                                 grp),
                                                                 ((CName "Having", loc),
                                                                  hopt),
                                                                 ((CName "SelectFields", loc),
@@ -732,3 +780,11 @@ wopt   :                                (sql_inject (EVar (["Basis"], "True"),
                                                      EVar (["Basis"], "sql_bool"),
                                                      ErrorMsg.dummySpan))
        | CWHERE sqlexp                  (sqlexp)
+
+groupi : tident DOT fident              (GField (tident, fident))
+
+groupis: groupi                         ([groupi])
+       | groupi COMMA groupis           (groupi :: groupis)
+
+gopt   :                                (NONE)
+       | GROUP BY groupis               (SOME groupis)
diff --git a/src/lacweb.lex b/src/lacweb.lex
index 70e55df7..0a7d2433 100644
--- a/src/lacweb.lex
+++ b/src/lacweb.lex
@@ -295,6 +295,8 @@ notags = [^<{\n]+;
 <INITIAL> "FROM"      => (Tokens.FROM (pos yypos, pos yypos + size yytext));
 <INITIAL> "AS"        => (Tokens.AS (pos yypos, pos yypos + size yytext));
 <INITIAL> "WHERE"     => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));
+<INITIAL> "GROUP"     => (Tokens.GROUP (pos yypos, pos yypos + size yytext));
+<INITIAL> "BY"        => (Tokens.BY (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "TRUE"      => (Tokens.TRUE (pos yypos, pos yypos + size yytext));
 <INITIAL> "FALSE"     => (Tokens.FALSE (pos yypos, pos yypos + size yytext));
diff --git a/tests/group_by.lac b/tests/group_by.lac
new file mode 100644
index 00000000..2b5d4dd1
--- /dev/null
+++ b/tests/group_by.lac
@@ -0,0 +1,5 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT * FROM t1 GROUP BY t1.B)
+val q2 = (SELECT * FROM t1, t2 GROUP BY t1.B, t2.D, t1.A)