SELECTing arbitrary expressions

4 files changed, 64 insertions, 42 deletions

diff --git a/lib/basis.lig b/lib/basis.lig
index b85587bb..bf8aab33 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -13,8 +13,8 @@ con sql_table :: {Type} -> Type
 
 (*** Queries *)
 
-con sql_query :: {{Type}} -> Type
-con sql_query1 :: {{Type}} -> {{Type}} -> Type
+con sql_query :: {{Type}} -> {Type} -> Type
+con sql_query1 :: {{Type}} -> {{Type}} -> {Type} -> Type
 con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type
 
 con sql_subset :: {{Type}} -> {{Type}} -> Type
@@ -31,14 +31,17 @@ val sql_subset_all : tables :: {{Type}}
 
 val sql_query1 : tables ::: {{Type}}
         -> grouped ::: {{Type}}
-        -> selected ::: {{Type}}
+        -> selectedFields ::: {{Type}}
+        -> selectedExps ::: {Type}
         -> {From : $(fold (fn nm => fn fields :: {Type} => fn acc =>
                 [nm] ~ acc => [nm = sql_table fields] ++ acc) [] tables),
             Where : sql_exp tables [] bool,
             GroupBy : sql_subset tables grouped,
             Having : sql_exp grouped tables bool,
-            SelectFields : sql_subset grouped selected}
-        -> sql_query1 tables selected
+            SelectFields : sql_subset grouped selectedFields,
+            SelectExps : $(fold (fn nm => fn t :: Type => fn acc =>
+                [nm] ~ acc => [nm = sql_exp grouped tables t] ++ acc) [] selectedExps) }
+        -> sql_query1 tables selectedFields selectedExps
 
 type sql_relop 
 val sql_union : sql_relop
@@ -47,8 +50,11 @@ val sql_except : sql_relop
 val sql_relop : sql_relop
         -> tables1 ::: {{Type}}
         -> tables2 ::: {{Type}}
-        -> selected ::: {{Type}}
-        -> sql_query1 tables1 selected -> sql_query1 tables2 selected -> sql_query1 selected selected
+        -> selectedFields ::: {{Type}}
+        -> selectedExps ::: {Type}
+        -> sql_query1 tables1 selectedFields selectedExps
+        -> sql_query1 tables2 selectedFields selectedExps
+        -> sql_query1 selectedFields selectedFields selectedExps
 
 type sql_direction
 val sql_asc : sql_direction
@@ -69,12 +75,13 @@ val sql_no_offset : sql_offset
 val sql_offset : int -> sql_offset
 
 val sql_query : tables ::: {{Type}}
-        -> selected ::: {{Type}}
-        -> {Rows : sql_query1 tables selected,
+        -> selectedFields ::: {{Type}}
+        -> selectedExps ::: {Type}
+        -> {Rows : sql_query1 tables selectedFields selectedExps,
             OrderBy : sql_order_by tables,
             Limit : sql_limit,
             Offset : sql_offset}
-        -> sql_query selected
+        -> sql_query selectedFields selectedExps
 
 val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type -> agg ::: {{Type}}
         -> tab :: Name -> field :: Name
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 97643170..9ea2ab58 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1520,7 +1520,8 @@ fun elabExp (env, denv) (eAll as (e, loc)) =
                             let
                                 val r = ref NONE
                             in
-                                ((L'.EUnif r, loc), ran, [TypeClass (env, dom, r, loc)])
+                                ((L'.EApp (e1', (L'.EUnif r, loc)), loc),
+                                 ran, [TypeClass (env, dom, r, loc)])
                             end
                           | SOME pf => ((L'.EApp (e1', pf), loc), ran, gs1 @ gs2 @ enD gs3 @ enD gs4)
                     end
diff --git a/src/lacweb.grm b/src/lacweb.grm
index 4352fa8c..8c6199dd 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -42,6 +42,7 @@ fun entable t =
 
 datatype select_item =
          Field of con * con
+       | Exp of con * exp
 
 datatype select =
          Star
@@ -56,25 +57,27 @@ fun eqTnames ((c1, _), (c2, _)) =
       | (CName x1, CName x2) => x1 = x2
       | _ => false
 
-fun amend_select loc (si, tabs) =
-    let
-        val (tx, c) = case si of
-                          Field (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 amend_select loc (si, (tabs, exps)) =
+    case si of
+        Field (tx, fx) =>
+        let
+            val c = (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, exps)
+        end
+      | Exp (c, e) => (tabs, (c, e) :: exps)
 
 fun amend_group loc (gi, tabs) =
     let
@@ -681,22 +684,24 @@ query1 : SELECT select FROM tables wopt gopt hopt
                                         (let
                                              val loc = s (SELECTleft, tablesright)
 
-                                             val sel =
+                                             val (sel, exps) =
                                                  case select of
-                                                     Star => map (fn (nm, _) =>
-                                                                     (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
-                                                                                    loc),
-                                                                                   (CRecord [], loc)],
-                                                                           loc))) tables
+                                                     Star => (map (fn (nm, _) =>
+                                                                      (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
+                                                                                     loc),
+                                                                                    (CRecord [], loc)],
+                                                                            loc))) tables,
+                                                              [])
                                                    | Items sis =>
                                                      let
                                                          val tabs = map (fn (nm, _) => (nm, (CRecord [], loc))) tables
-                                                         val tabs = foldl (amend_select loc) tabs sis
+                                                         val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
                                                      in
-                                                         map (fn (nm, c) => (nm,
-                                                                             (CTuple [c,
-                                                                                      (CWild (KRecord (KType, loc), loc),
-                                                                                       loc)], loc))) tabs
+                                                         (map (fn (nm, c) => (nm,
+                                                                              (CTuple [c,
+                                                                                       (CWild (KRecord (KType, loc), loc),
+                                                                                        loc)], loc))) tabs,
+                                                          exps)
                                                      end
 
                                              val sel = (CRecord sel, loc)
@@ -733,7 +738,9 @@ query1 : SELECT select FROM tables wopt gopt hopt
                                                                  hopt),
                                                                 ((CName "SelectFields", loc),
                                                                  (ECApp ((EVar (["Basis"], "sql_subset"), loc),
-                                                                         sel), loc))], loc)
+                                                                         sel), loc)),
+                                                                ((CName "SelectExps", loc),
+                                                                 (ERecord exps, loc))], loc)
 
                                              val e = (EApp (e, re), loc)
                                          in
@@ -762,6 +769,7 @@ fident : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLr
        | LBRACE cexp RBRACE             (cexp)
 
 seli   : tident DOT fident              (Field (tident, fident))
+       | sqlexp AS fident               (Exp (fident, sqlexp))
 
 selis  : seli                           ([seli])
        | seli COMMA selis               (seli :: selis)
diff --git a/tests/selexp.lac b/tests/selexp.lac
new file mode 100644
index 00000000..11bb7965
--- /dev/null
+++ b/tests/selexp.lac
@@ -0,0 +1,6 @@
+table t1 : {A : int, B : string, C : float}
+table t2 : {A : float, D : int}
+
+val q1 = (SELECT 0 AS Zero FROM t1)
+val q2 = (SELECT t1.A < t2.D AS Lt FROM t1, t2)
+val q3 = (SELECT t1.A < t2.D AS Lt, t1.A, t2.D, t1.C = t2.A AS Eq FROM t1, t2)