diff src/urweb.grm @ 704:70cbdcf5989b

UNIQUE constraints
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 12:24:31 -0400
parents 500e93aa436f
children e6706a1df013
line wrap: on
line diff
--- a/src/urweb.grm	Sun Apr 05 16:17:32 2009 -0400
+++ b/src/urweb.grm	Tue Apr 07 12:24:31 2009 -0400
@@ -208,6 +208,7 @@
  | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS
  | CURRENT_TIMESTAMP
  | NE | LT | LE | GT | GE
+ | CCONSTRAINT | UNIQUE
 
 %nonterm
    file of decl list
@@ -222,6 +223,10 @@
  | dcons of (string * con option) list
  | dcon of string * con option
 
+ | cst of exp
+ | csts of exp
+ | cstopt of exp
+
  | sgn of sgn
  | sgntm of sgn
  | sgi of sgn_item
@@ -289,6 +294,9 @@
  | query1 of exp
  | tables of (con * exp) list
  | tname of con
+ | tnameW of (con * con)
+ | tnames of con
+ | tnames' of (con * con) list
  | table of con * exp
  | tident of con
  | fident of con
@@ -410,7 +418,7 @@
                                            | 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 cexp        ([(DTable (SYMBOL, entable cexp), s (TABLEleft, cexpright))])
+       | TABLE SYMBOL COLON cterm cstopt([(DTable (SYMBOL, entable cterm, cstopt), s (TABLEleft, cstoptright))])
        | SEQUENCE SYMBOL                ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
        | CLASS SYMBOL EQ cexp           (let
                                              val loc = s (CLASSleft, cexpright)
@@ -460,6 +468,50 @@
 copt   :                                (NONE)
        | COLON cexp                     (SOME cexp)
 
+cstopt :                                (EVar (["Basis"], "no_constraint", Infer), dummy)
+       | csts                           (csts)
+
+csts   : CCONSTRAINT tname cst          (let
+                                             val loc = s (CCONSTRAINTleft, cstright)
+                                                       
+                                             val e = (EVar (["Basis"], "one_constraint", Infer), loc)
+                                             val e = (ECApp (e, tname), loc)
+                                         in
+                                             (EApp (e, cst), loc)
+                                         end)
+       | csts COMMA csts                (let
+                                             val loc = s (csts1left, csts2right)
+
+                                             val e = (EVar (["Basis"], "join_constraints", Infer), loc)
+                                             val e = (EApp (e, csts1), loc)
+                                         in
+                                             (EApp (e, csts2), loc)
+                                         end)
+       | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
+
+cst    : UNIQUE tnames                  (let
+                                             val loc = s (UNIQUEleft, tnamesright)
+                                                       
+                                             val e = (EVar (["Basis"], "unique", Infer), loc)
+                                             val e = (ECApp (e, tnames), loc)
+                                         in
+                                             (EDisjointApp e, loc)
+                                         end)
+       | LBRACE eexp RBRACE             (eexp)
+
+tnameW : tname                          (let
+                                             val loc = s (tnameleft, tnameright)
+                                         in
+                                             (tname, (CWild (KType, loc), loc))
+                                         end)
+
+tnames : tnameW                         (CRecord [tnameW], s (tnameWleft, tnameWright))
+       | LPAREN tnames' RPAREN          (CRecord tnames', s (LPARENleft, RPARENright))
+       | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
+
+tnames': tnameW                         ([tnameW])
+       | tnameW COMMA tnames'           (tnameW :: tnames')
+
 valis  : vali                           ([vali])
        | vali AND valis                 (vali :: valis)