changeset 226:b0041cc7e5f7

Basic GROUP BY
author Adam Chlipala <adamc@hcoop.net>
date Thu, 21 Aug 2008 13:59:49 -0400 (2008-08-21)
parents 5ac2cf59b839
children 524e10c91478
files src/lacweb.grm src/lacweb.lex tests/group_by.lac
diffstat 3 files changed, 68 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/src/lacweb.grm	Thu Aug 21 13:47:18 2008 -0400
+++ b/src/lacweb.grm	Thu Aug 21 13:59:49 2008 -0400
@@ -46,6 +46,9 @@
          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 @@
         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 @@
  | 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 @@
  | 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 @@
  | 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 @@
        | 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 @@
 
                                              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 @@
                                                                 ((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 @@
                                                      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)
--- a/src/lacweb.lex	Thu Aug 21 13:47:18 2008 -0400
+++ b/src/lacweb.lex	Thu Aug 21 13:59:49 2008 -0400
@@ -295,6 +295,8 @@
 <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));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/group_by.lac	Thu Aug 21 13:59:49 2008 -0400
@@ -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)