Parsing INSERT

4 files changed, 40 insertions, 2 deletions

diff --git a/lib/basis.urs b/lib/basis.urs
index ff5c2163..13bb1de1 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -205,7 +205,8 @@ val dml : dml -> transaction unit
 
 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
diff --git a/src/urweb.grm b/src/urweb.grm
index 27a06191..1d47f36c 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -179,6 +179,7 @@ fun native_op (oper, e1, e2, loc) =
  | 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 @@ fun native_op (oper, e1, e2, loc) =
  | 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 @@ eterm  : LPAREN eexp RPAREN             (#1 eexp, s (LPARENleft, RPARENright))
        | 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)
 
diff --git a/src/urweb.lex b/src/urweb.lex
index e47546b3..1e7876b4 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -335,6 +335,13 @@ notags = [^<{\n]+;
 <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));
 
diff --git a/tests/insert.ur b/tests/insert.ur
index 58db4ef1..c718fb7e 100644
--- a/tests/insert.ur
+++ b/tests/insert.ur
@@ -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>