diff src/urweb.grm @ 310:0aee86b8a6d6

Automatically add table annotations in UPDATE and DELETE
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 15:35:08 -0400
parents 99e4f39e820d
children e457d8972ff1
line wrap: on
line diff
--- a/src/urweb.grm	Sun Sep 07 15:16:10 2008 -0400
+++ b/src/urweb.grm	Sun Sep 07 15:35:08 2008 -0400
@@ -150,6 +150,8 @@
         (EApp (e, e2), loc)
     end
 
+val inDml = ref false
+
 %%
 %header (functor UrwebLrValsFn(structure Token : TOKEN))
 
@@ -284,6 +286,8 @@
  | fields of con list
  | sqlexps of exp list
  | fsets of (con * exp) list
+ | enterDml of unit
+ | leaveDml of unit
 
 
 %verbose                                (* print summary of errors *)
@@ -748,7 +752,7 @@
                                                  ();
                                              (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc)
                                          end)
-       | LPAREN UPDATE texp SET fsets CWHERE sqlexp RPAREN
+       | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN
                                         (let
                                              val loc = s (LPARENleft, RPARENright)
 
@@ -758,7 +762,7 @@
                                          in
                                              (EApp (e, sqlexp), loc)
                                          end)
-       | LPAREN DELETE FROM texp CWHERE sqlexp RPAREN
+       | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN
                                         (let
                                              val loc = s (LPARENleft, RPARENright)
 
@@ -770,6 +774,9 @@
 
        | UNDER                          (EWild, s (UNDERleft, UNDERright))
 
+enterDml :                              (inDml := true)
+leaveDml :                              (inDml := false)
+
 texp   : SYMBOL                         (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
        | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
 
@@ -1026,10 +1033,21 @@
                                          end)
        | CSYMBOL                         (let
                                              val loc = s (CSYMBOLleft, CSYMBOLright)
-                                             val e = (EVar (["Basis"], "sql_exp"), loc)
-                                         in
-                                             (ECApp (e, (CName CSYMBOL, loc)), loc)
-                                         end)
+                                          in
+                                              if !inDml then
+                                                  let
+                                                      val e = (EVar (["Basis"], "sql_field"), loc)
+                                                      val e = (ECApp (e, (CName "T", loc)), loc)
+                                                  in
+                                                      (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                                  end
+                                              else
+                                                  let
+                                                      val e = (EVar (["Basis"], "sql_exp"), loc)
+                                                  in
+                                                      (ECApp (e, (CName CSYMBOL, loc)), loc)
+                                                  end
+                                          end)
 
        | sqlexp EQ sqlexp               (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
        | sqlexp NE sqlexp               (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))