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>