Mercurial > urweb
changeset 302:bc89dfdbc495
Parsing INSERT
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 07 Sep 2008 14:07:10 -0400 |
| parents | 54282db31a9b |
| children | 7204fab29486 |
| files | lib/basis.urs src/urweb.grm src/urweb.lex tests/insert.ur |
| diffstat | 4 files changed, 40 insertions(+), 2 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/basis.urs Sun Sep 07 13:52:42 2008 -0400 +++ b/lib/basis.urs Sun Sep 07 14:07:10 2008 -0400 @@ -205,7 +205,8 @@ val insert : fields ::: {Type} -> sql_table fields - -> $fields + -> $(fold (fn nm (t :: Type) acc => [nm] ~ acc => + [nm = sql_exp [T = fields] [] [] t] ++ acc) [] fields) -> dml val update : changed ::: {Type} -> unchanged ::: {Type} -> changed ~ unchanged
--- a/src/urweb.grm Sun Sep 07 13:52:42 2008 -0400 +++ b/src/urweb.grm Sun Sep 07 14:07:10 2008 -0400 @@ -179,6 +179,7 @@ | TRUE | FALSE | CAND | OR | NOT | COUNT | AVG | SUM | MIN | MAX | ASC | DESC + | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NE | LT | LE | GT | GE %nonterm @@ -279,6 +280,10 @@ | sqlint of exp | sqlagg of string + | texp of exp + | fields of con list + | sqlexps of exp list + %verbose (* print summary of errors *) %pos int (* positions *) @@ -725,10 +730,35 @@ | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)), (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), s (XML_BEGINleft, XML_ENDright)) + | LPAREN query RPAREN (query) | LPAREN CWHERE sqlexp RPAREN (sqlexp) + + | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN + (let + val loc = s (LPAREN1left, RPAREN3right) + + val e = (EVar (["Basis"], "insert"), loc) + val e = (EApp (e, texp), loc) + in + if length fields <> length sqlexps then + ErrorMsg.errorAt loc "Length mismatch in INSERT field specification" + else + (); + (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc) + end) + | UNDER (EWild, s (UNDERleft, UNDERright)) +texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)) + | LBRACE LBRACE eexp RBRACE RBRACE (eexp) + +fields : fident ([fident]) + | fident COMMA fields (fident :: fields) + +sqlexps: sqlexp ([sqlexp]) + | sqlexp COMMA sqlexps (sqlexp :: sqlexps) + idents : ident ([ident]) | ident DOT idents (ident :: idents)
--- a/src/urweb.lex Sun Sep 07 13:52:42 2008 -0400 +++ b/src/urweb.lex Sun Sep 07 14:07:10 2008 -0400 @@ -335,6 +335,13 @@ <INITIAL> "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext)); <INITIAL> "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext)); +<INITIAL> "INSERT" => (Tokens.INSERT (pos yypos, pos yypos + size yytext)); +<INITIAL> "INTO" => (Tokens.INTO (pos yypos, pos yypos + size yytext)); +<INITIAL> "VALUES" => (Tokens.VALUES (pos yypos, pos yypos + size yytext)); +<INITIAL> "UPDATE" => (Tokens.UPDATE (pos yypos, pos yypos + size yytext)); +<INITIAL> "SET" => (Tokens.SET (pos yypos, pos yypos + size yytext)); +<INITIAL> "DELETE" => (Tokens.DELETE (pos yypos, pos yypos + size yytext)); + <INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext)); <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
--- a/tests/insert.ur Sun Sep 07 13:52:42 2008 -0400 +++ b/tests/insert.ur Sun Sep 07 14:07:10 2008 -0400 @@ -1,5 +1,5 @@ table t1 : {A : int, B : string, C : float, D : bool} fun main () : transaction page = - () <- dml (insert t1 {A = 5, B = "6", C = 7.0, D = True}); + () <- dml (INSERT INTO t1 (A, B, C, D) VALUES (5, "6", 7.0, TRUE)); return <html><body>Inserted.</body></html>