diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-09-07 14:07:10 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-09-07 14:07:10 -0400 |
| commit | a034349c535b054c9d31beb4e1133f8cd0b68c5a (patch) | |
| tree | 3c2892afafe8179b14dca536dcd0b0da34165b96 /src/urweb.grm | |
| parent | 071f5b9a8c042414e427d72142c078a64cf9b0d7 (diff) | |
Parsing INSERT
Diffstat (limited to 'src/urweb.grm')
| -rw-r--r-- | src/urweb.grm | 30 |
1 files changed, 30 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) |