summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 14:07:10 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-07 14:07:10 -0400
commita034349c535b054c9d31beb4e1133f8cd0b68c5a (patch)
tree3c2892afafe8179b14dca536dcd0b0da34165b96
parent071f5b9a8c042414e427d72142c078a64cf9b0d7 (diff)
Parsing INSERT
-rw-r--r--lib/basis.urs3
-rw-r--r--src/urweb.grm30
-rw-r--r--src/urweb.lex7
-rw-r--r--tests/insert.ur2
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>