summaryrefslogtreecommitdiff
path: root/src/urweb.grm
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-07 16:14:31 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-07 16:14:31 -0400
commit26ad31287745567b98b357de9793a0e795c63334 (patch)
tree6fa2aa05d829b2b71c6e2d778b4898999992a00f /src/urweb.grm
parent98370da7e9f70e3d83f666019b765e15f617b846 (diff)
PRIMARY KEY
Diffstat (limited to 'src/urweb.grm')
-rw-r--r--src/urweb.grm39
1 files changed, 32 insertions, 7 deletions
diff --git a/src/urweb.grm b/src/urweb.grm
index 0f4b58d7..a507e52e 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -208,7 +208,7 @@ fun tagIn bt =
| INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS
| CURRENT_TIMESTAMP
| NE | LT | LE | GT | GE
- | CCONSTRAINT | UNIQUE
+ | CCONSTRAINT | UNIQUE | PRIMARY | KEY
%nonterm
file of decl list
@@ -223,6 +223,9 @@ fun tagIn bt =
| dcons of (string * con option) list
| dcon of string * con option
+ | pkopt of exp
+ | commaOpt of unit
+
| cst of exp
| csts of exp
| cstopt of exp
@@ -418,7 +421,8 @@ decl : CON SYMBOL cargl2 kopt EQ cexp (let
| m :: ms => [(DOpenConstraints (m, ms), s (OPENleft, mpathright))])
| CONSTRAINT cterm TWIDDLE cterm ([(DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))])
| EXPORT spath ([(DExport spath, s (EXPORTleft, spathright))])
- | TABLE SYMBOL COLON cterm cstopt([(DTable (SYMBOL, entable cterm, cstopt), s (TABLEleft, cstoptright))])
+ | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt([(DTable (SYMBOL, entable cterm, pkopt, cstopt),
+ s (TABLEleft, cstoptright))])
| SEQUENCE SYMBOL ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
| CLASS SYMBOL EQ cexp (let
val loc = s (CLASSleft, cexpright)
@@ -513,6 +517,27 @@ tnames : tnameW (tnameW, [])
tnames': tnameW (tnameW, [])
| tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames')
+commaOpt: ()
+ | COMMA ()
+
+pkopt : (EVar (["Basis"], "no_primary_key", Infer), ErrorMsg.dummySpan)
+ | PRIMARY KEY tnames (let
+ val loc = s (PRIMARYleft, tnamesright)
+
+ val e = (EVar (["Basis"], "primary_key", Infer), loc)
+ val e = (ECApp (e, #1 (#1 tnames)), loc)
+ val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
+ val e = (EDisjointApp e, loc)
+ val e = (EDisjointApp e, loc)
+
+ val witness = map (fn (c, _) =>
+ (c, (EWild, loc)))
+ (#1 tnames :: #2 tnames)
+ val witness = (ERecord witness, loc)
+ in
+ (EApp (e, witness), loc)
+ end)
+
valis : vali ([vali])
| vali AND valis (vali :: valis)
@@ -554,11 +579,11 @@ sgi : CON SYMBOL DCOLON kind ((SgiConAbs (SYMBOL, kind), s (CONleft,
s (FUNCTORleft, sgn2right)))
| INCLUDE sgn ((SgiInclude sgn, s (INCLUDEleft, sgnright)))
| CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)))
- | TABLE SYMBOL COLON cterm cstopt(let
- val loc = s (TABLEleft, ctermright)
- in
- (SgiTable (SYMBOL, entable cterm, cstopt), loc)
- end)
+ | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt (let
+ val loc = s (TABLEleft, ctermright)
+ in
+ (SgiTable (SYMBOL, entable cterm, pkopt, cstopt), loc)
+ end)
| SEQUENCE SYMBOL (let
val loc = s (SEQUENCEleft, SYMBOLright)
val t = (CVar (["Basis"], "sql_sequence"), loc)