diff src/lacweb.grm @ 233:c466678af854

SELECTing arbitrary expressions
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 Aug 2008 11:17:14 -0400
parents a338da9d82f3
children 82409ef72019
line wrap: on
line diff
--- a/src/lacweb.grm	Thu Aug 21 16:03:45 2008 -0400
+++ b/src/lacweb.grm	Thu Aug 28 11:17:14 2008 -0400
@@ -42,6 +42,7 @@
 
 datatype select_item =
          Field of con * con
+       | Exp of con * exp
 
 datatype select =
          Star
@@ -56,25 +57,27 @@
       | (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))
+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
-    end
+            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 @@
                                         (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 @@
                                                                  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 @@
        | 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)