Parsing INSERT

2 files changed, 37 insertions, 0 deletions

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));