UNIQUE constraints

28 files changed, 311 insertions, 117 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 78c2e63b..7f8b2434 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -104,7 +104,7 @@ datatype decl' =
        | DFun of string * int * (string * typ) list * typ * exp
        | DFunRec of (string * int * (string * typ) list * typ * exp) list
 
-       | DTable of string * (string * typ) list
+       | DTable of string * (string * typ) list * (string * string) list
        | DSequence of string
        | DDatabase of {name : string, expunge : int, initialize : int}
        | DPreparedStatements of (string * int) list
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 54ec3cbf..9fc1511f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1435,7 +1435,7 @@ fun p_exp' par env (e, loc) =
             val wontLeakAnything = notLeaky env false state
         in
             box [if wontLeakAnything then
-                     string "uw_begin_region(ctx), "
+                     string "(uw_begin_region(ctx), "
                  else
                      box [],
                  string "({",
@@ -1585,7 +1585,11 @@ fun p_exp' par env (e, loc) =
                      box [],
                  string "acc;",
                  newline,
-                 string "})"]
+                 string "})",
+                 if wontLeakAnything then
+                     string ")"
+                 else
+                     box []]
         end
 
       | EDml {dml, prepared} =>
@@ -1937,10 +1941,19 @@ fun p_decl env (dAll as (d, _) : decl) =
                  p_list_sep newline (p_fun env) vis,
                  newline]
         end
-      | DTable (x, _) => box [string "/* SQL table ",
-                              string x,
-                              string " */",
-                              newline]
+      | DTable (x, _, csts) => box [string "/* SQL table ",
+                                    string x,
+                                    space,
+                                    string "constraints",
+                                    space,
+                                    p_list (fn (x, v) => box [string x,
+                                                              space,
+                                                              string ":",
+                                                              space,
+                                                              string v]) csts,
+                                    space,
+                                    string " */",
+                                    newline]
       | DSequence x => box [string "/* SQL sequence ",
                             string x,
                             string " */",
@@ -2454,7 +2467,7 @@ fun p_file env (ds, ps) =
 
         val pds' = map p_page ps
 
-        val tables = List.mapPartial (fn (DTable (s, xts), _) => SOME (s, xts)
+        val tables = List.mapPartial (fn (DTable (s, xts, _), _) => SOME (s, xts)
                                        | _ => NONE) ds
         val sequences = List.mapPartial (fn (DSequence s, _) => SOME s
                                           | _ => NONE) ds
@@ -2798,7 +2811,7 @@ fun p_sql env (ds, _) =
                        (fn (dAll as (d, _), env) =>
                            let
                                val pp = case d of
-                                            DTable (s, xts) =>
+                                            DTable (s, xts, csts) =>
                                             box [string "CREATE TABLE ",
                                                  string s,
                                                  string "(",
@@ -2807,6 +2820,20 @@ fun p_sql env (ds, _) =
                                                                  string (CharVector.map Char.toLower x),
                                                                  space,
                                                                  p_sqltype env (t, ErrorMsg.dummySpan)]) xts,
+                                                 case csts of
+                                                     [] => box []
+                                                   | _ => box [string ","],
+                                                 cut,
+                                                 p_list_sep (box [string ",", newline])
+                                                            (fn (x, c) =>
+                                                                box [string "CONSTRAINT",
+                                                                     space,
+                                                                     string s,
+                                                                     string "_",
+                                                                     string x,
+                                                                     space,
+                                                                     string c]) csts,
+                                                 newline,
                                                  string ");",
                                                  newline,
                                                  newline]
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 5e4b647a..839c0c57 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -524,7 +524,7 @@ fun cifyDecl ((d, loc), sm) =
             (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndPullAndPush), sm)
         end
 
-      | L.DTable (s, xts) =>
+      | L.DTable (s, xts, e) =>
         let
             val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
                                                   let
@@ -532,8 +532,18 @@ fun cifyDecl ((d, loc), sm) =
                                                   in
                                                       ((x, t), sm)
                                                   end) sm xts
+
+            fun flatten e =
+                case #1 e of
+                    L.ERecord [] => []
+                  | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)]
+                  | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
+                  | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
+                          Print.prefaces "Undetermined constraint"
+                          [("e", MonoPrint.p_exp MonoEnv.empty e)];
+                          [])
         in
-            (SOME (L'.DTable (s, xts), loc), NONE, sm)
+            (SOME (L'.DTable (s, xts, flatten e), loc), NONE, sm)
         end
       | L.DSequence s =>
         (SOME (L'.DSequence s, loc), NONE, sm)
diff --git a/src/core.sml b/src/core.sml
index b384c576..74ef138c 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -130,7 +130,7 @@ datatype decl' =
        | DVal of string * int * con * exp * string
        | DValRec of (string * int * con * exp * string) list
        | DExport of export_kind * int
-       | DTable of string * int * con * string
+       | DTable of string * int * con * string * exp
        | DSequence of string * int * string
        | DDatabase of string
        | DCookie of string * int * con * string
diff --git a/src/core_env.sml b/src/core_env.sml
index dd77e3fb..d1e956d8 100644
--- a/src/core_env.sml
+++ b/src/core_env.sml
@@ -313,7 +313,7 @@ fun declBinds env (d, loc) =
       | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s
       | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis
       | DExport _ => env
-      | DTable (x, n, c, s) =>
+      | DTable (x, n, c, s, _) =>
         let
             val t = (CApp ((CFfi ("Basis", "sql_table"), loc), c), loc)
         in
diff --git a/src/core_print.sml b/src/core_print.sml
index cc6e5428..d68ba288 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -546,17 +546,21 @@ fun p_decl env (dAll as (d, _) : decl) =
                                 space,
                                 (p_con env (#2 (E.lookupENamed env n))
                                  handle E.UnboundNamed _ => string "UNBOUND")]
-      | DTable (x, n, c, s) => box [string "table",
-                                    space,
-                                    p_named x n,
-                                    space,
-                                    string "as",
-                                    space,
-                                    string s,
-                                    space,
-                                    string ":",
-                                    space,
-                                    p_con env c]
+      | DTable (x, n, c, s, e) => box [string "table",
+                                       space,
+                                       p_named x n,
+                                       space,
+                                       string "as",
+                                       space,
+                                       string s,
+                                       space,
+                                       string ":",
+                                       space,
+                                       p_con env c,
+                                       space,
+                                       string "constraints",
+                                       space,
+                                       p_exp env e]
       | DSequence (x, n, s) => box [string "sequence",
                                     space,
                                     p_named x n,
diff --git a/src/core_util.sml b/src/core_util.sml
index b1d07b79..b342f2f7 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -933,10 +933,12 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
                             (DValRec vis', loc))
                 end
               | DExport _ => S.return2 dAll
-              | DTable (x, n, c, s) =>
-                S.map2 (mfc ctx c,
+              | DTable (x, n, c, s, e) =>
+                S.bind2 (mfc ctx c,
                      fn c' =>
-                        (DTable (x, n, c', s), loc))
+                        S.map2 (mfe ctx e,
+                                fn e' =>
+                                   (DTable (x, n, c', s, e'), loc)))
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
               | DCookie (x, n, c, s) =>
@@ -1058,7 +1060,7 @@ fun mapfoldB (all as {bind, ...}) =
                                         foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
                                         ctx vis
                                       | DExport _ => ctx
-                                      | DTable (x, n, c, s) =>
+                                      | DTable (x, n, c, s, _) =>
                                         let
                                             val t = (CApp ((CFfi ("Basis", "sql_table"), #2 d'), c), #2 d')
                                         in
@@ -1134,7 +1136,7 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
                           | DVal (_, n, _, _, _) => Int.max (n, count)
                           | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
                           | DExport _ => count
-                          | DTable (_, n, _, _) => Int.max (n, count)
+                          | DTable (_, n, _, _, _) => Int.max (n, count)
                           | DSequence (_, n, _) => Int.max (n, count)
                           | DDatabase _ => count
                           | DCookie (_, n, _, _) => Int.max (n, count)) 0
diff --git a/src/corify.sml b/src/corify.sml
index 9ca6c915..fc8bb1de 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -976,12 +976,12 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
              end
            | _ => raise Fail "Non-const signature for 'export'")
 
-      | L.DTable (_, x, n, c) =>
+      | L.DTable (_, x, n, c, e) =>
         let
             val (st, n) = St.bindVal st x n
             val s = relify (doRestify (mods, x))
         in
-            ([(L'.DTable (x, n, corifyCon st c, s), loc)], st)
+            ([(L'.DTable (x, n, corifyCon st c, s, corifyExp st e), loc)], st)
         end
       | L.DSequence (_, x, n) =>
         let
@@ -1052,7 +1052,7 @@ fun maxName ds = foldl (fn ((d, _), n) =>
                              | L.DStr (_, n', _, str) => Int.max (n, Int.max (n', maxNameStr str))
                              | L.DFfiStr (_, n', _) => Int.max (n, n')
                              | L.DExport _ => n
-                             | L.DTable (_, _, n', _) => Int.max (n, n')
+                             | L.DTable (_, _, n', _, _) => Int.max (n, n')
                              | L.DSequence (_, _, n') => Int.max (n, n')
                              | L.DDatabase _ => n
                              | L.DCookie (_, _, n', _) => Int.max (n, n'))
diff --git a/src/elab.sml b/src/elab.sml
index 3fed1918..dd2952d2 100644
--- a/src/elab.sml
+++ b/src/elab.sml
@@ -166,7 +166,7 @@ datatype decl' =
        | DFfiStr of string * int * sgn
        | DConstraint of con * con
        | DExport of int * sgn * str
-       | DTable of int * string * int * con
+       | DTable of int * string * int * con * exp
        | DSequence of int * string * int
        | DClass of string * int * kind * con
        | DDatabase of string
diff --git a/src/elab_env.sml b/src/elab_env.sml
index 370e504f..7adc8dd9 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -1532,7 +1532,7 @@ fun declBinds env (d, loc) =
       | DFfiStr (x, n, sgn) => pushStrNamedAs env x n sgn
       | DConstraint _ => env
       | DExport _ => env
-      | DTable (tn, x, n, c) =>
+      | DTable (tn, x, n, c, _) =>
         let
             val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
         in
diff --git a/src/elab_print.sml b/src/elab_print.sml
index 64d8cfab..f98592cc 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -740,13 +740,17 @@ fun p_decl env (dAll as (d, _) : decl) =
                                       string ":",
                                       space,
                                       p_sgn env sgn]
-      | DTable (_, x, n, c) => box [string "table",
-                                    space,
-                                    p_named x n,
-                                    space,
-                                    string ":",
-                                    space,
-                                    p_con env c]
+      | DTable (_, x, n, c, e) => box [string "table",
+                                       space,
+                                       p_named x n,
+                                       space,
+                                       string ":",
+                                       space,
+                                       p_con env c,
+                                       space,
+                                       string "constraints",
+                                       space,
+                                       p_exp env e]
       | DSequence (_, x, n) => box [string "sequence",
                                     space,
                                     p_named x n]
diff --git a/src/elab_util.sml b/src/elab_util.sml
index e2dd0ce6..6700686d 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -766,7 +766,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
                                                    bind (ctx, Str (x, sgn))
                                                  | DConstraint _ => ctx
                                                  | DExport _ => ctx
-                                                 | DTable (tn, x, n, c) =>
+                                                 | DTable (tn, x, n, c, _) =>
                                                    bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "sql_table"), loc),
                                                                                 c), loc)))
                                                  | DSequence (tn, x, n) =>
@@ -864,10 +864,12 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
                                     fn str' =>
                                        (DExport (en, sgn', str'), loc)))
 
-              | DTable (tn, x, n, c) =>
-                S.map2 (mfc ctx c,
+              | DTable (tn, x, n, c, e) =>
+                S.bind2 (mfc ctx c,
                         fn c' =>
-                           (DTable (tn, x, n, c'), loc))
+                           S.map2 (mfe ctx e,
+                                   fn e' =>
+                                      (DTable (tn, x, n, c', e'), loc)))
               | DSequence _ => S.return2 dAll
 
               | DClass (x, n, k, c) =>
@@ -1018,7 +1020,7 @@ and maxNameDecl (d, _) =
       | DConstraint _ => 0
       | DClass (_, n, _, _) => n
       | DExport _ => 0
-      | DTable (n1, _, n2, _) => Int.max (n1, n2)
+      | DTable (n1, _, n2, _, _) => Int.max (n1, n2)
       | DSequence (n1, _, n2) => Int.max (n1, n2)
       | DDatabase _ => 0
       | DCookie (n1, _, n2, _) => Int.max (n1, n2)
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 81af6a79..0beab9e7 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1126,11 +1126,11 @@
                  else
                      (e, t, [])
                | t => (e, t, [])
-    in
-        case infer of
-            L.DontInfer => (e, t, [])
-          | _ => unravel (t, e)
-    end
+     in
+         case infer of
+             L.DontInfer => (e, t, [])
+           | _ => unravel (t, e)
+     end
 
 fun elabPat (pAll as (p, loc), (env, bound)) =
     let
@@ -2319,7 +2319,7 @@ fun sgiOfDecl (d, loc) =
       | L'.DFfiStr (x, n, sgn) => [(L'.SgiStr (x, n, sgn), loc)]
       | L'.DConstraint cs => [(L'.SgiConstraint cs, loc)]
       | L'.DExport _ => []
-      | L'.DTable (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (tableOf (), c), loc)), loc)]
+      | L'.DTable (tn, x, n, c, _) => [(L'.SgiVal (x, n, (L'.CApp (tableOf (), c), loc)), loc)]
       | L'.DSequence (tn, x, n) => [(L'.SgiVal (x, n, sequenceOf ()), loc)]
       | L'.DClass (x, n, k, c) => [(L'.SgiClass (x, n, k, c), loc)]
       | L'.DDatabase _ => []
@@ -3265,13 +3265,20 @@ fun elabDecl (dAll as (d, loc), (env, denv, gs)) =
                     ([(L'.DExport (E.newNamed (), sgn, str'), loc)], (env, denv, gs' @ gs))
                 end
 
-              | L.DTable (x, c) =>
+              | L.DTable (x, c, e) =>
                 let
                     val (c', k, gs') = elabCon (env, denv) c
                     val (env, n) = E.pushENamed env x (L'.CApp (tableOf (), c'), loc)
+                    val (e', et, gs'') = elabExp (env, denv) e
+
+                    val names = cunif (loc, (L'.KRecord (L'.KUnit, loc), loc))
+                    val cst = (L'.CModProj (!basis_r, [], "sql_constraints"), loc)
+                    val cst = (L'.CApp (cst, names), loc)
+                    val cst = (L'.CApp (cst, c'), loc)
                 in
                     checkKind env c' k (L'.KRecord (L'.KType, loc), loc);
-                    ([(L'.DTable (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs))
+                    checkCon env e' et cst;
+                    ([(L'.DTable (!basis_r, x, n, c', e'), loc)], (env, denv, gs'' @ enD gs' @ gs))
                 end
               | L.DSequence x =>
                 let
diff --git a/src/expl.sml b/src/expl.sml
index d7138620..a347a8e8 100644
--- a/src/expl.sml
+++ b/src/expl.sml
@@ -141,7 +141,7 @@ datatype decl' =
        | DStr of string * int * sgn * str
        | DFfiStr of string * int * sgn
        | DExport of int * sgn * str
-       | DTable of int * string * int * con
+       | DTable of int * string * int * con * exp
        | DSequence of int * string * int
        | DDatabase of string
        | DCookie of int * string * int * con
diff --git a/src/expl_env.sml b/src/expl_env.sml
index 403a826a..f4e16cb5 100644
--- a/src/expl_env.sml
+++ b/src/expl_env.sml
@@ -298,7 +298,7 @@ fun declBinds env (d, loc) =
       | DStr (x, n, sgn, _) => pushStrNamed env x n sgn
       | DFfiStr (x, n, sgn) => pushStrNamed env x n sgn
       | DExport _ => env
-      | DTable (tn, x, n, c) =>
+      | DTable (tn, x, n, c, _) =>
         let
             val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
         in
diff --git a/src/expl_print.sml b/src/expl_print.sml
index e7fb51f6..c7a506b1 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -663,13 +663,17 @@ fun p_decl env (dAll as (d, _) : decl) =
                                       string ":",
                                       space,
                                       p_sgn env sgn]
-      | DTable (_, x, n, c) => box [string "table",
-                                    space,
-                                    p_named x n,
-                                    space,
-                                    string ":",
-                                    space,
-                                    p_con env c]
+      | DTable (_, x, n, c, e) => box [string "table",
+                                       space,
+                                       p_named x n,
+                                       space,
+                                       string ":",
+                                       space,
+                                       p_con env c,
+                                       space,
+                                       string "constraints",
+                                       space,
+                                       p_exp env e]
       | DSequence (_, x, n) => box [string "sequence",
                                     space,
                                     p_named x n]
diff --git a/src/explify.sml b/src/explify.sml
index f9f58c65..d567bde3 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -178,7 +178,7 @@ fun explifyDecl (d, loc : EM.span) =
       | L.DFfiStr (x, n, sgn) => SOME (L'.DFfiStr (x, n, explifySgn sgn), loc)
       | L.DConstraint (c1, c2) => NONE
       | L.DExport (en, sgn, str) => SOME (L'.DExport (en, explifySgn sgn, explifyStr str), loc)
-      | L.DTable (nt, x, n, c) => SOME (L'.DTable (nt, x, n, explifyCon c), loc)
+      | L.DTable (nt, x, n, c, e) => SOME (L'.DTable (nt, x, n, explifyCon c, explifyExp e), loc)
       | L.DSequence (nt, x, n) => SOME (L'.DSequence (nt, x, n), loc)
       | L.DClass (x, n, k, c) => SOME (L'.DCon (x, n,
                                                 (L'.KArrow (explifyKind k, (L'.KType, loc)), loc), explifyCon c), loc)
diff --git a/src/mono.sml b/src/mono.sml
index 02afb2c0..5a65a9f9 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -121,7 +121,7 @@ datatype decl' =
        | DValRec of (string * int * typ * exp * string) list
        | DExport of Core.export_kind * string * int * typ list * typ
 
-       | DTable of string * (string * typ) list
+       | DTable of string * (string * typ) list * exp
        | DSequence of string
        | DDatabase of {name : string, expunge : int, initialize : int}
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a8ece085..935f8368 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -403,18 +403,22 @@ fun p_decl env (dAll as (d, _) : decl) =
                                           space,
                                           p_typ env t]
 
-      | DTable (s, xts) => box [string "(* SQL table ",
-                                string s,
-                                space,
-                                string ":",
-                                space,
-                                p_list (fn (x, t) => box [string x,
-                                                          space,
-                                                          string ":",
-                                                          space,
-                                                          p_typ env t]) xts,
-                                space,
-                                string "*)"]
+      | DTable (s, xts, e) => box [string "(* SQL table ",
+                                   string s,
+                                   space,
+                                   string ":",
+                                   space,
+                                   p_list (fn (x, t) => box [string x,
+                                                             space,
+                                                             string ":",
+                                                             space,
+                                                             p_typ env t]) xts,
+                                   space,
+                                   string "constraints",
+                                   space,
+                                   p_exp env e,
+                                   space,
+                                   string "*)"]
       | DSequence s => box [string "(* SQL sequence ",
                             string s,
                             string "*)"]
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 9455435c..ca5cf5cb 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -465,7 +465,10 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
                            S.map2 (mft t,
                                    fn t' =>
                                       (DExport (ek, s, n, ts', t'), loc)))
-              | DTable _ => S.return2 dAll
+              | DTable (s, xts, e) =>
+                S.map2 (mfe ctx e,
+                        fn e' =>
+                           (DTable (s, xts, e'), loc))
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
               | DJavaScript _ => S.return2 dAll
diff --git a/src/monoize.sml b/src/monoize.sml
index 620e43a5..af414c08 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -149,6 +149,10 @@ fun monoType env =
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
+                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "sql_constraints"), loc)
+                  | L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_subset"), _), _), _), _) =>
                     (L'.TRecord [], loc)
@@ -1155,6 +1159,32 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
+          | L.ECApp ((L.EFfi ("Basis", "no_constraint"), _), _) =>
+            ((L'.ERecord [], loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "one_constraint"), _), _), _), (L.CName name, _)) =>
+            ((L'.EAbs ("c",
+                       (L'.TFfi ("Basis", "string"), loc),
+                       (L'.TFfi ("Basis", "sql_constraints"), loc),
+                       (L'.ERecord [(name, (L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))], loc)), loc),
+             fm)
+          | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "join_constraints"), _), _), _), _), _), _) =>
+            let
+                val constraints = (L'.TFfi ("Basis", "sql_constraints"), loc)
+            in
+                ((L'.EAbs ("cs1", constraints, (L'.TFun (constraints, constraints), loc),
+                           (L'.EAbs ("cs2", constraints, constraints,
+                                     (L'.EStrcat ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+                 fm)
+            end
+
+          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "unique"), _), _), _),
+                     (L.CRecord (_, unique), _)) =>
+            ((L'.EPrim (Prim.String ("UNIQUE ("
+                                     ^ String.concatWith ", " (map (fn (x, _) => "uw_" ^ monoName env x) unique)
+                                     ^ ")")), loc),
+             fm)
+
           | L.EFfiApp ("Basis", "dml", [e]) =>
             let
                 val (e, fm) = monoExp (env, st, fm) e
@@ -2451,19 +2481,21 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             in
                 SOME (env, fm, [(L'.DExport (ek, s, n, ts, ran), loc)])
             end
-          | L.DTable (x, n, (L.CRecord (_, xts), _), s) =>
+          | L.DTable (x, n, (L.CRecord (_, xts), _), s, e) =>
             let
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
                 val s = "uw_" ^ s
-                val e = (L'.EPrim (Prim.String s), loc)
+                val e_name = (L'.EPrim (Prim.String s), loc)
 
                 val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
+
+                val (e, fm) = monoExp (env, St.empty, fm) e
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
-                      [(L'.DTable (s, xts), loc),
-                       (L'.DVal (x, n, t', e, s), loc)])
+                      [(L'.DTable (s, xts, e), loc),
+                       (L'.DVal (x, n, t', e_name, s), loc)])
             end
           | L.DTable _ => poly ()
           | L.DSequence (x, n, s) =>
@@ -2583,7 +2615,7 @@ fun monoize env file =
             in
                 foldl (fn ((d, _), e) =>
                           case d of
-                              L.DTable (_, _, xts, tab) => doTable (tab, #1 xts, e)
+                              L.DTable (_, _, xts, tab, _) => doTable (tab, #1 xts, e)
                             | _ => e) e file
             end
 
@@ -2628,7 +2660,7 @@ fun monoize env file =
             in
                 foldl (fn ((d, _), e) =>
                           case d of
-                              L.DTable (_, _, xts, tab) => doTable (tab, #1 xts, e)
+                              L.DTable (_, _, xts, tab, _) => doTable (tab, #1 xts, e)
                             | _ => e) e file
             end
 
diff --git a/src/pathcheck.sml b/src/pathcheck.sml
index 036d286f..6771e628 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -38,6 +38,13 @@ structure SS = BinarySetFn(struct
 
 fun checkDecl ((d, loc), (funcs, rels)) =
     let
+        fun doFunc s =
+            (if SS.member (funcs, s) then
+                 E.errorAt loc ("Duplicate function path " ^ s)
+             else
+                 ();
+             (SS.add (funcs, s), rels))
+
         fun doRel s =
             (if SS.member (rels, s) then
                  E.errorAt loc ("Duplicate table/sequence path " ^ s)
@@ -46,14 +53,27 @@ fun checkDecl ((d, loc), (funcs, rels)) =
              (funcs, SS.add (rels, s)))
     in
         case d of
-            DExport (_, s, _, _, _) =>
-            (if SS.member (funcs, s) then
-                 E.errorAt loc ("Duplicate function path " ^ s)
-             else
-                 ();
-             (SS.add (funcs, s), rels))
+            DExport (_, s, _, _, _) => doFunc s
             
-          | DTable (s, _) => doRel s
+          | DTable (s, _, e) =>
+            let
+                fun constraints (e, rels) =
+                    case #1 e of
+                        ERecord [(s', _, _)] =>
+                        let
+                            val s' = s ^ "_" ^ s'
+                        in
+                            if SS.member (rels, s') then
+                                E.errorAt loc ("Duplicate constraint path " ^ s')
+                            else
+                                ();
+                            SS.add (rels, s')
+                        end
+                      | EStrcat (e1, e2) => constraints (e2, constraints (e1, rels))
+                      | _ => rels
+            in
+                (funcs, constraints (e, #2 (doRel s)))
+            end
           | DSequence s => doRel s
 
           | _ => (funcs, rels)
diff --git a/src/reduce.sml b/src/reduce.sml
index 8664d38d..6754d708 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -461,7 +461,8 @@ fun reduce file =
                 ((DValRec (map (fn (x, n, t, e, s) => (x, n, con namedC [] t, exp (namedC, namedE) [] e, s)) vis), loc),
                  st)
               | DExport _ => (d, st)
-              | DTable (s, n, c, s') => ((DTable (s, n, con namedC [] c, s'), loc), st)
+              | DTable (s, n, c, s', e) => ((DTable (s, n, con namedC [] c, s',
+                                                     exp (namedC, namedE) [] e), loc), st)
               | DSequence _ => (d, st)
               | DDatabase _ => (d, st)
               | DCookie (s, n, c, s') => ((DCookie (s, n, con namedC [] c, s'), loc), st)
diff --git a/src/shake.sml b/src/shake.sml
index 4df64efa..2f873e94 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -46,11 +46,26 @@ val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan)
 
 fun shake file =
     let
-        val (page_es, table_cs) =
+        val usedVars = U.Exp.fold {kind = fn (_, st) => st,
+                                   con = fn (c, st as (es, cs)) =>
+                                            case c of
+                                                CNamed n => (es, IS.add (cs, n))
+                                              | _ => st,
+                                   exp = fn (e, st as (es, cs)) =>
+                                            case e of
+                                                ENamed n => (IS.add (es, n), cs)
+                                              | _ => st}
+
+        val (usedE, usedC, table_cs) =
             List.foldl
-                (fn ((DExport (_, n), _), (page_es, table_cs)) => (n :: page_es, table_cs)
-                  | ((DTable (_, _, c, _), _), (page_es, table_cs)) => (page_es, c :: table_cs)
-                  | (_, acc) => acc) ([], []) file
+                (fn ((DExport (_, n), _), (usedE, usedC, table_cs)) => (IS.add (usedE, n), usedE, table_cs)
+                  | ((DTable (_, _, c, _, e), _), (usedE, usedC, table_cs)) =>
+                    let
+                        val (usedE, usedC) = usedVars (usedE, usedC) e
+                    in
+                        (usedE, usedC, c :: table_cs)
+                    end
+                  | (_, acc) => acc) (IS.empty, IS.empty, []) file
 
         val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
                                    | ((DDatatype (_, n, _, xncs), _), (cdef, edef)) =>
@@ -64,7 +79,7 @@ fun shake file =
                                                           IM.insert (edef, n, (all_ns, t, e))) edef vis)
                                      end
                                    | ((DExport _, _), acc) => acc
-                                   | ((DTable (_, n, c, _), _), (cdef, edef)) =>
+                                   | ((DTable (_, n, c, _, _), _), (cdef, edef)) =>
                                      (cdef, IM.insert (edef, n, ([], c, dummye)))
                                    | ((DSequence (_, n, _), _), (cdef, edef)) =>
                                      (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
@@ -122,17 +137,17 @@ fun shake file =
 
         and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s
 
-        val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)}
-
-        val s = foldl (fn (n, s) =>
-                          case IM.find (edef, n) of
-                              NONE => raise Fail "Shake: Couldn't find 'val'"
-                            | SOME (ns, t, e) =>
-                              let
-                                  val s = shakeExp (shakeCon s t) e
-                              in
-                                  foldl (fn (n, s) => exp (ENamed n, s)) s ns
-                              end) s page_es
+        val s = {con = usedC, exp = usedE}
+
+        val s = IS.foldl (fn (n, s) =>
+                             case IM.find (edef, n) of
+                                 NONE => raise Fail "Shake: Couldn't find 'val'"
+                               | SOME (ns, t, e) =>
+                                 let
+                                     val s = shakeExp (shakeCon s t) e
+                                 in
+                                     foldl (fn (n, s) => exp (ENamed n, s)) s ns
+                                 end) s usedE
 
         val s = foldl (fn (c, s) => shakeCon s c) s table_cs
     in
diff --git a/src/source.sml b/src/source.sml
index 9ef14fd9..42927ef3 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -160,7 +160,7 @@ datatype decl' =
        | DConstraint of con * con
        | DOpenConstraints of string * string list
        | DExport of str
-       | DTable of string * con
+       | DTable of string * con * exp
        | DSequence of string
        | DClass of string * kind * con
        | DDatabase of string
diff --git a/src/source_print.sml b/src/source_print.sml
index 8d8b28c3..d1c9b6df 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -588,13 +588,17 @@ fun p_decl ((d, _) : decl) =
       | DExport str => box [string "export",
                             space,
                             p_str str]
-      | DTable (x, c) => box [string "table",
-                              space,
-                              string x,
-                              space,
-                              string ":",
-                              space,
-                              p_con c]
+      | DTable (x, c, e) => box [string "table",
+                                 space,
+                                 string x,
+                                 space,
+                                 string ":",
+                                 space,
+                                 p_con c,
+                                 space,
+                                 string "constraints",
+                                 space,
+                                 p_exp e]
       | DSequence x => box [string "sequence",
                             space,
                             string x]
diff --git a/src/urweb.grm b/src/urweb.grm
index 98ba295a..784c62ee 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -208,6 +208,7 @@ fun tagIn bt =
  | 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 @@ fun tagIn bt =
  | 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 @@ fun tagIn bt =
  | 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 @@ 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 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 @@ vali   : SYMBOL eargl2 copt EQ eexp     (let
 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)
 
diff --git a/src/urweb.lex b/src/urweb.lex
index 4a7ceaeb..735d230d 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -365,6 +365,9 @@ notags = [^<{\n]+;
 <INITIAL> "NULL"      => (Tokens.NULL (pos yypos, pos yypos + size yytext));
 <INITIAL> "IS"        => (Tokens.IS (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
+<INITIAL> "UNIQUE"    => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));
+
 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
 
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));