Mercurial > urweb

comparison src/urweb.grm @ 310:0aee86b8a6d6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
309:ea62b15da922 310:0aee86b8a6d6
148 val e = (EApp (e, e1), loc) 148 val e = (EApp (e, e1), loc)
149 in 149 in
150 (EApp (e, e2), loc) 150 (EApp (e, e2), loc)
151 end 151 end
152 152
153 val inDml = ref false
154
153 %% 155 %%
154 %header (functor UrwebLrValsFn(structure Token : TOKEN)) 156 %header (functor UrwebLrValsFn(structure Token : TOKEN))
155 157
156 %term 158 %term
157 EOF 159 EOF
282 284
283 | texp of exp 285 | texp of exp
284 | fields of con list 286 | fields of con list
285 | sqlexps of exp list 287 | sqlexps of exp list
286 | fsets of (con * exp) list 288 | fsets of (con * exp) list
289 | enterDml of unit
290 | leaveDml of unit
287 291
288 292
289 %verbose (* print summary of errors *) 293 %verbose (* print summary of errors *)
290 %pos int (* positions *) 294 %pos int (* positions *)
291 %start file 295 %start file
746 ErrorMsg.errorAt loc "Length mismatch in INSERT field specification" 750 ErrorMsg.errorAt loc "Length mismatch in INSERT field specification"
747 else 751 else
748 (); 752 ();
749 (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc) 753 (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc)
750 end) 754 end)
751 | LPAREN UPDATE texp SET fsets CWHERE sqlexp RPAREN 755 | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN
752 (let 756 (let
753 val loc = s (LPARENleft, RPARENright) 757 val loc = s (LPARENleft, RPARENright)
754 758
755 val e = (EVar (["Basis"], "update"), loc) 759 val e = (EVar (["Basis"], "update"), loc)
756 val e = (EApp (e, (ERecord fsets, loc)), loc) 760 val e = (EApp (e, (ERecord fsets, loc)), loc)
757 val e = (EApp (e, texp), loc) 761 val e = (EApp (e, texp), loc)
758 in 762 in
759 (EApp (e, sqlexp), loc) 763 (EApp (e, sqlexp), loc)
760 end) 764 end)
761 | LPAREN DELETE FROM texp CWHERE sqlexp RPAREN 765 | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN
762 (let 766 (let
763 val loc = s (LPARENleft, RPARENright) 767 val loc = s (LPARENleft, RPARENright)
764 768
765 val e = (EVar (["Basis"], "delete"), loc) 769 val e = (EVar (["Basis"], "delete"), loc)
766 val e = (EApp (e, texp), loc) 770 val e = (EApp (e, texp), loc)
767 in 771 in
768 (EApp (e, sqlexp), loc) 772 (EApp (e, sqlexp), loc)
769 end) 773 end)
770 774
771 | UNDER (EWild, s (UNDERleft, UNDERright)) 775 | UNDER (EWild, s (UNDERleft, UNDERright))
776
777 enterDml : (inDml := true)
778 leaveDml : (inDml := false)
772 779
773 texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)) 780 texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
774 | LBRACE LBRACE eexp RBRACE RBRACE (eexp) 781 | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
775 782
776 fields : fident ([fident]) 783 fields : fident ([fident])
1024 in 1031 in
1025 (ECApp (e, fident), loc) 1032 (ECApp (e, fident), loc)
1026 end) 1033 end)
1027 | CSYMBOL (let 1034 | CSYMBOL (let
1028 val loc = s (CSYMBOLleft, CSYMBOLright) 1035 val loc = s (CSYMBOLleft, CSYMBOLright)
1029 val e = (EVar (["Basis"], "sql_exp"), loc) 1036 in
1030 in 1037 if !inDml then
1031 (ECApp (e, (CName CSYMBOL, loc)), loc) 1038 let
1032 end) 1039 val e = (EVar (["Basis"], "sql_field"), loc)
1040 val e = (ECApp (e, (CName "T", loc)), loc)
1041 in
1042 (ECApp (e, (CName CSYMBOL, loc)), loc)
1043 end
1044 else
1045 let
1046 val e = (EVar (["Basis"], "sql_exp"), loc)
1047 in
1048 (ECApp (e, (CName CSYMBOL, loc)), loc)
1049 end
1050 end)
1033 1051
1034 | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1052 | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1035 | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1053 | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1036 | sqlexp LT sqlexp (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1054 | sqlexp LT sqlexp (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1037 | sqlexp LE sqlexp (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1055 | sqlexp LE sqlexp (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))