Mercurial > urweb
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)))