diff src/urweb.grm @ 707:d8217b4cb617

PRIMARY KEY
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 16:14:31 -0400
parents 1fb318c17546
children 0406e9cccb72
line wrap: on
line diff
--- a/src/urweb.grm	Tue Apr 07 15:04:07 2009 -0400
+++ b/src/urweb.grm	Tue Apr 07 16:14:31 2009 -0400
@@ -208,7 +208,7 @@
  | 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 @@
  | 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 @@
                                            | 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, [])
        | 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 @@
                                           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)