summaryrefslogtreecommitdiff
path: root/src/urweb.grm
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 15:35:08 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 15:35:08 -0400
commit1a83e7956edd7711c6e379fdfca8aad88495cb44 (patch)
tree1934d17a7a58d4c4fe67e6d5e4b696dedc0b3504 /src/urweb.grm
parent6471ebba2ec8aa38b4735263162181a3b7084b47 (diff)
Automatically add table annotations in UPDATE and DELETE
Diffstat (limited to 'src/urweb.grm')
-rw-r--r--src/urweb.grm30
1 files changed, 24 insertions, 6 deletions
diff --git a/src/urweb.grm b/src/urweb.grm
index 61e8d179..efa35117 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -150,6 +150,8 @@ fun native_op (oper, e1, e2, loc) =
(EApp (e, e2), loc)
end
+val inDml = ref false
+
%%
%header (functor UrwebLrValsFn(structure Token : TOKEN))
@@ -284,6 +286,8 @@ fun native_op (oper, e1, e2, loc) =
| 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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
();
(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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
| 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 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"),
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)))