PRIMARY KEY

28 files changed, 322 insertions, 172 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 7f8b2434..33cf07c9 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 * (string * string) list
+       | DTable of string * (string * typ) list * string * (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 9fc1511f..f86d4928 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1941,19 +1941,25 @@ fun p_decl env (dAll as (d, _) : decl) =
                  p_list_sep newline (p_fun env) vis,
                  newline]
         end
-      | 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]
+      | DTable (x, _, pk, csts) => box [string "/* SQL table ",
+                                        string x,
+                                        space,
+                                        case pk of
+                                            "" => box []
+                                          | _ => box [string "keys",
+                                                      space,
+                                                      string pk,
+                                                      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 " */",
@@ -2467,7 +2473,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
@@ -2811,7 +2817,7 @@ fun p_sql env (ds, _) =
                        (fn (dAll as (d, _), env) =>
                            let
                                val pp = case d of
-                                            DTable (s, xts, csts) =>
+                                            DTable (s, xts, pk, csts) =>
                                             box [string "CREATE TABLE ",
                                                  string s,
                                                  string "(",
@@ -2820,10 +2826,23 @@ 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 ","],
+                                                 case (pk, csts) of
+                                                     ("", []) => box []
+                                                   | _ => string ",",
                                                  cut,
+                                                 case pk of
+                                                     "" => box []
+                                                   | _ => box [string "PRIMARY",
+                                                               space,
+                                                               string "KEY",
+                                                               space,
+                                                               string "(",
+                                                               string pk,
+                                                               string ")",
+                                                               case csts of
+                                                                   [] => box []
+                                                                 | _ => string ",",
+                                                               newline],
                                                  p_list_sep (box [string ",", newline])
                                                             (fn (x, c) =>
                                                                 box [string "CONSTRAINT",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 839c0c57..e0341c64 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, e) =>
+      | L.DTable (s, xts, pe, ce) =>
         let
             val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
                                                   let
@@ -540,10 +540,17 @@ fun cifyDecl ((d, loc), sm) =
                   | 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)];
+                                         [("e", MonoPrint.p_exp MonoEnv.empty e)];
                           [])
+
+            val pe = case #1 pe of
+                         L.EPrim (Prim.String s) => s
+                       | _ => (ErrorMsg.errorAt loc "Primary key has not been fully determined";
+                               Print.prefaces "Undetermined constraint"
+                                              [("e", MonoPrint.p_exp MonoEnv.empty pe)];
+                               "")
         in
-            (SOME (L'.DTable (s, xts, flatten e), loc), NONE, sm)
+            (SOME (L'.DTable (s, xts, pe, flatten ce), 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 687b913f..a8e0de13 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 * exp * con
+       | DTable of string * int * con * string * exp * con * exp * con
        | 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 4c4cc68f..95226bb7 100644
--- a/src/core_env.sml
+++ b/src/core_env.sml
@@ -313,11 +313,11 @@ 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, _, cc) =>
+      | DTable (x, n, c, s, _, pc, _, cc) =>
         let
             val ct = (CFfi ("Basis", "sql_table"), loc)
             val ct = (CApp (ct, c), loc)
-            val ct = (CApp (ct, cc), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
         in
             pushENamed env x n ct NONE s
         end
diff --git a/src/core_print.sml b/src/core_print.sml
index 216cc8ac..ed401d29 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -546,21 +546,25 @@ 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, 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]
+      | DTable (x, n, c, s, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string "as",
+                                                  space,
+                                                  string s,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp env ce]
       | 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 df8bb271..320a0326 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -933,14 +933,18 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
                             (DValRec vis', loc))
                 end
               | DExport _ => S.return2 dAll
-              | DTable (x, n, c, s, e, cc) =>
+              | DTable (x, n, c, s, pe, pc, ce, cc) =>
                 S.bind2 (mfc ctx c,
                      fn c' =>
-                        S.bind2 (mfe ctx e,
-                                fn e' =>
-                                   S.map2 (mfc ctx cc,
-                                           fn cc' =>
-                                              (DTable (x, n, c', s, e', cc'), loc))))
+                        S.bind2 (mfe ctx pe,
+                                fn pe' =>
+                                   S.bind2 (mfc ctx pc,
+                                           fn pc' =>
+                                              S.bind2 (mfe ctx ce,
+                                                    fn ce' =>
+                                                       S.map2 (mfc ctx cc,
+                                                            fn cc' =>
+                                                               (DTable (x, n, c', s, pe', pc', ce', cc'), loc))))))
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
               | DCookie (x, n, c, s) =>
@@ -1062,11 +1066,11 @@ 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, _, cc) =>
+                                      | DTable (x, n, c, s, _, pc, _, cc) =>
                                         let
                                             val loc = #2 d'
                                             val ct = (CFfi ("Basis", "sql_table"), loc)
-                                            val ct = (CApp (ct, c), loc)
+                                            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
                                             val ct = (CApp (ct, cc), loc)
                                         in
                                             bind (ctx, NamedE (x, n, ct, NONE, s))
@@ -1141,7 +1145,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 3387e73a..e3b9a365 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -976,12 +976,14 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
              end
            | _ => raise Fail "Non-const signature for 'export'")
 
-      | L.DTable (_, x, n, c, e, cc) =>
+      | L.DTable (_, x, n, c, pe, pc, ce, cc) =>
         let
             val (st, n) = St.bindVal st x n
             val s = relify (doRestify (mods, x))
         in
-            ([(L'.DTable (x, n, corifyCon st c, s, corifyExp st e, corifyCon st cc), loc)], st)
+            ([(L'.DTable (x, n, corifyCon st c, s,
+                          corifyExp st pe, corifyCon st pc,
+                          corifyExp st ce, corifyCon st cc), loc)], st)
         end
       | L.DSequence (_, x, n) =>
         let
@@ -1052,7 +1054,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 c31483ec..83a7f929 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 * exp * con
+       | DTable of int * string * int * con * exp * con * exp * con
        | 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 8bb769c1..8da78375 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -1532,11 +1532,11 @@ fun declBinds env (d, loc) =
       | DFfiStr (x, n, sgn) => pushStrNamedAs env x n sgn
       | DConstraint _ => env
       | DExport _ => env
-      | DTable (tn, x, n, c, _, cc) =>
+      | DTable (tn, x, n, c, _, pc, _, cc) =>
         let
             val ct = (CModProj (tn, [], "sql_table"), loc)
             val ct = (CApp (ct, c), loc)
-            val ct = (CApp (ct, cc), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
         in
             pushENamedAs env x n ct
         end
diff --git a/src/elab_print.sml b/src/elab_print.sml
index b65e1bd6..7eb853af 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -740,17 +740,21 @@ fun p_decl env (dAll as (d, _) : decl) =
                                       string ":",
                                       space,
                                       p_sgn env sgn]
-      | 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]
+      | DTable (_, x, n, c, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp env ce]
       | DSequence (_, x, n) => box [string "sequence",
                                     space,
                                     p_named x n]
diff --git a/src/elab_util.sml b/src/elab_util.sml
index 32f399dc..ff4abbfb 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -766,11 +766,11 @@ 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, _, cc) =>
+                                                 | DTable (tn, x, n, c, _, pc, _, cc) =>
                                                    let
                                                        val ct = (CModProj (n, [], "sql_table"), loc)
                                                        val ct = (CApp (ct, c), loc)
-                                                       val ct = (CApp (ct, cc), loc)
+                                                       val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
                                                    in
                                                        bind (ctx, NamedE (x, ct))
                                                    end
@@ -869,14 +869,18 @@ 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, e, cc) =>
+              | DTable (tn, x, n, c, pe, pc, ce, cc) =>
                 S.bind2 (mfc ctx c,
                         fn c' =>
-                           S.bind2 (mfe ctx e,
-                                   fn e' =>
-                                      S.map2 (mfc ctx cc,
-                                              fn cc' =>
-                                                 (DTable (tn, x, n, c', e', cc'), loc))))
+                           S.bind2 (mfe ctx pe,
+                                   fn pe' =>
+                                      S.bind2 (mfc ctx pc,
+                                            fn pc' =>
+                                               S.bind2 (mfe ctx ce,
+                                                     fn ce' =>
+                                                        S.map2 (mfc ctx cc,
+                                                              fn cc' =>
+                                                                 (DTable (tn, x, n, c', pe', pc', ce', cc'), loc))))))
               | DSequence _ => S.return2 dAll
 
               | DClass (x, n, k, c) =>
@@ -1027,7 +1031,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 d83af65b..c2ac31a4 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2027,7 +2027,7 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
             ([(L'.SgiVal (x, n, c'), loc)], (env', denv, gs' @ gs))
         end
 
-      | L.SgiTable (x, c, e) =>
+      | L.SgiTable (x, c, pe, ce) =>
         let
             val cstK = (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc)
             val x' = x ^ "_hidden_constraints"
@@ -2035,28 +2035,38 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
             val hidden = (L'.CNamed hidden_n, loc)
 
             val (c', ck, gs') = elabCon (env, denv) c
+            val pkey = cunif (loc, cstK)
             val visible = cunif (loc, cstK)
             val uniques = (L'.CConcat (visible, hidden), loc)
 
             val ct = tableOf ()
             val ct = (L'.CApp (ct, c'), loc)
-            val ct = (L'.CApp (ct, uniques), loc)
+            val ct = (L'.CApp (ct, (L'.CConcat (pkey, uniques), loc)), loc)
+
+            val (pe', pet, gs'') = elabExp (env', denv) pe
+            val gs'' = List.mapPartial (fn Disjoint x => SOME x
+                                          | _ => NONE) gs''
+
+            val pst = (L'.CModProj (!basis_r, [], "primary_key"), loc)
+            val pst = (L'.CApp (pst, c'), loc)
+            val pst = (L'.CApp (pst, pkey), loc)
 
             val (env', n) = E.pushENamed env' x ct
 
-            val (e', et, gs'') = elabExp (env, denv) e
-            val gs'' = List.mapPartial (fn Disjoint x => SOME x
-                                         | _ => NONE) gs''
+            val (ce', cet, gs''') = elabExp (env', denv) ce
+            val gs''' = List.mapPartial (fn Disjoint x => SOME x
+                                         | _ => NONE) gs'''
 
             val cst = (L'.CModProj (!basis_r, [], "sql_constraints"), loc)
             val cst = (L'.CApp (cst, c'), loc)
             val cst = (L'.CApp (cst, visible), loc)
         in
             checkKind env c' ck (L'.KRecord (L'.KType, loc), loc);
-            checkCon env' e' et cst;
+            checkCon env' pe' pet pst;
+            checkCon env' ce' cet cst;
 
             ([(L'.SgiConAbs (x', hidden_n, cstK), loc),
-              (L'.SgiVal (x, n, ct), loc)], (env', denv, gs'' @ gs' @ gs))
+              (L'.SgiVal (x, n, ct), loc)], (env', denv, gs''' @ gs'' @ gs' @ gs))
         end
 
       | L.SgiStr (x, sgn) =>
@@ -2360,8 +2370,9 @@ and 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, _, cc) =>
-        [(L'.SgiVal (x, n, (L'.CApp ((L'.CApp (tableOf (), c), loc), cc), loc)), loc)]
+      | L'.DTable (tn, x, n, c, _, pc, _, cc) =>
+        [(L'.SgiVal (x, n, (L'.CApp ((L'.CApp (tableOf (), c), loc),
+                                     (L'.CConcat (pc, cc), loc)), 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 _ => []
@@ -3307,25 +3318,35 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
                     ([(L'.DExport (E.newNamed (), sgn, str'), loc)], (env, denv, gs' @ gs))
                 end
 
-              | L.DTable (x, c, e) =>
+              | L.DTable (x, c, pe, ce) =>
                 let
+                    val cstK = (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc)
+
                     val (c', k, gs') = elabCon (env, denv) c
-                    val uniques = cunif (loc, (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc))
+                    val pkey = cunif (loc, cstK)
+                    val uniques = cunif (loc, cstK)
 
                     val ct = tableOf ()
                     val ct = (L'.CApp (ct, c'), loc)
-                    val ct = (L'.CApp (ct, uniques), loc)
+                    val ct = (L'.CApp (ct, (L'.CConcat (pkey, uniques), loc)), loc)
 
                     val (env, n) = E.pushENamed env x ct
-                    val (e', et, gs'') = elabExp (env, denv) e
+                    val (pe', pet, gs'') = elabExp (env, denv) pe
+                    val (ce', cet, gs''') = elabExp (env, denv) ce
+
+                    val pst = (L'.CModProj (!basis_r, [], "primary_key"), loc)
+                    val pst = (L'.CApp (pst, c'), loc)
+                    val pst = (L'.CApp (pst, pkey), loc)
 
                     val cst = (L'.CModProj (!basis_r, [], "sql_constraints"), loc)
                     val cst = (L'.CApp (cst, c'), loc)
                     val cst = (L'.CApp (cst, uniques), loc)
                 in
                     checkKind env c' k (L'.KRecord (L'.KType, loc), loc);
-                    checkCon env e' et cst;
-                    ([(L'.DTable (!basis_r, x, n, c', e', uniques), loc)], (env, denv, gs'' @ enD gs' @ gs))
+                    checkCon env pe' pet pst;
+                    checkCon env ce' cet cst;
+                    ([(L'.DTable (!basis_r, x, n, c', pe', pkey, ce', uniques), loc)],
+                     (env, denv, gs''' @ gs'' @ enD gs' @ gs))
                 end
               | L.DSequence x =>
                 let
diff --git a/src/expl.sml b/src/expl.sml
index 6cd9b7a8..b9cbdaf1 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 * exp * con
+       | DTable of int * string * int * con * exp * con * exp * con
        | 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 31b1c0a3..64f4edc4 100644
--- a/src/expl_env.sml
+++ b/src/expl_env.sml
@@ -298,11 +298,11 @@ 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, _, cc) =>
+      | DTable (tn, x, n, c, _, pc, _, cc) =>
         let
             val ct = (CModProj (tn, [], "sql_table"), loc)
             val ct = (CApp (ct, c), loc)
-            val ct = (CApp (ct, cc), loc)
+            val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc)
         in
             pushENamed env x n ct
         end
diff --git a/src/expl_print.sml b/src/expl_print.sml
index 05d68941..84002c00 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -663,17 +663,21 @@ fun p_decl env (dAll as (d, _) : decl) =
                                       string ":",
                                       space,
                                       p_sgn env sgn]
-      | 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]
+      | DTable (_, x, n, c, pe, _, ce, _) => box [string "table",
+                                                  space,
+                                                  p_named x n,
+                                                  space,
+                                                  string ":",
+                                                  space,
+                                                  p_con env c,
+                                                  space,
+                                                  string "keys",
+                                                  space,
+                                                  p_exp env pe,
+                                                  space,
+                                                  string "constraints",
+                                                  space,
+                                                  p_exp env ce]
       | DSequence (_, x, n) => box [string "sequence",
                                     space,
                                     p_named x n]
diff --git a/src/explify.sml b/src/explify.sml
index fa35bd0d..01a57d2e 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -178,7 +178,10 @@ 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, e, cc) => SOME (L'.DTable (nt, x, n, explifyCon c, explifyExp e, explifyCon cc), loc)
+      | L.DTable (nt, x, n, c, pe, pc, ce, cc) =>
+        SOME (L'.DTable (nt, x, n, explifyCon c,
+                         explifyExp pe, explifyCon pc,
+                         explifyExp ce, explifyCon cc), 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 5a65a9f9..35db52bd 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 * exp
+       | DTable of string * (string * typ) list * exp * 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 935f8368..c75e81ba 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -403,22 +403,26 @@ fun p_decl env (dAll as (d, _) : decl) =
                                           space,
                                           p_typ env t]
 
-      | 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 "*)"]
+      | DTable (s, xts, pe, ce) => 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 "keys",
+                                        space,
+                                        p_exp env pe,
+                                        space,
+                                        string "constraints",
+                                        space,
+                                        p_exp env ce,
+                                        space,
+                                        string "*)"]
       | DSequence s => box [string "(* SQL sequence ",
                             string s,
                             string "*)"]
diff --git a/src/mono_util.sml b/src/mono_util.sml
index ca5cf5cb..485e64f6 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -465,10 +465,12 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
                            S.map2 (mft t,
                                    fn t' =>
                                       (DExport (ek, s, n, ts', t'), loc)))
-              | DTable (s, xts, e) =>
-                S.map2 (mfe ctx e,
-                        fn e' =>
-                           (DTable (s, xts, e'), loc))
+              | DTable (s, xts, pe, ce) =>
+                S.bind2 (mfe ctx pe,
+                      fn pe' =>
+                         S.map2 (mfe ctx ce,
+                              fn ce' =>
+                                 (DTable (s, xts, pe', ce'), loc)))
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
               | DJavaScript _ => S.return2 dAll
diff --git a/src/monoize.sml b/src/monoize.sml
index 057a9222..2e514b4e 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -149,6 +149,8 @@ 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", "primary_key"), _), _), _), _) =>
+                    (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraints"), _), _), _), _) =>
                     (L'.TFfi ("Basis", "sql_constraints"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_constraint"), _), _), _), _) =>
@@ -1159,6 +1161,25 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                  fm)
             end
 
+          | L.ECApp ((L.EFfi ("Basis", "no_primary_key"), _), _) =>
+            ((L'.EPrim (Prim.String ""), loc),
+             fm)
+          | L.ECApp (
+            (L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "primary_key"), _), _), _), t), _),
+                      nm), _),
+            (L.CRecord (_, unique), _)) =>
+            let
+                val unique = (nm, t) :: unique
+                val witnesses = (L'.TRecord (map (fn (nm, _) => (monoName env nm, (L'.TRecord [], loc))) unique), loc)
+            in
+                ((L'.EAbs ("_", witnesses, (L'.TFfi ("Basis", "string"), loc),
+                           (L'.EPrim (Prim.String
+                                          (String.concatWith ", "
+                                                             (map (fn (x, _) => "uw_" ^ monoName env x) unique))),
+                            loc)), loc),
+                 fm)
+            end
+
           | L.ECApp ((L.EFfi ("Basis", "no_constraint"), _), _) =>
             ((L'.ERecord [], loc),
              fm)
@@ -2499,7 +2520,7 @@ 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, e, _) =>
+          | L.DTable (x, n, (L.CRecord (_, xts), _), s, pe, _, ce, _) =>
             let
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
@@ -2508,11 +2529,12 @@ fun monoDecl (env, fm) (all as (d, loc)) =
 
                 val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts
 
-                val (e, fm) = monoExp (env, St.empty, fm) e
+                val (pe, fm) = monoExp (env, St.empty, fm) pe
+                val (ce, fm) = monoExp (env, St.empty, fm) ce
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
-                      [(L'.DTable (s, xts, e), loc),
+                      [(L'.DTable (s, xts, pe, ce), loc),
                        (L'.DVal (x, n, t', e_name, s), loc)])
             end
           | L.DTable _ => poly ()
@@ -2633,7 +2655,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
 
@@ -2678,7 +2700,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 6771e628..3f4f6be4 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -55,7 +55,7 @@ fun checkDecl ((d, loc), (funcs, rels)) =
         case d of
             DExport (_, s, _, _, _) => doFunc s
             
-          | DTable (s, _, e) =>
+          | DTable (s, _, pe, ce) =>
             let
                 fun constraints (e, rels) =
                     case #1 e of
@@ -71,8 +71,22 @@ fun checkDecl ((d, loc), (funcs, rels)) =
                         end
                       | EStrcat (e1, e2) => constraints (e2, constraints (e1, rels))
                       | _ => rels
+
+                val rels = #2 (doRel s)
+                val rels = case #1 pe of
+                               EPrim (Prim.String "") => rels
+                             | _ =>
+                               let
+                                   val s' = s ^ "_Pkey"
+                               in
+                                   if SS.member (rels, s') then
+                                       E.errorAt loc ("Duplicate primary key constraint path " ^ s')
+                                   else
+                                       ();
+                                   SS.add (rels, s')
+                               end
             in
-                (funcs, constraints (e, #2 (doRel s)))
+                (funcs, constraints (ce, rels))
             end
           | DSequence s => doRel s
 
diff --git a/src/reduce.sml b/src/reduce.sml
index d6357f1b..25cc6274 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -461,9 +461,11 @@ 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', e, cc) => ((DTable (s, n, con namedC [] c, s',
-                                                         exp (namedC, namedE) [] e,
-                                                         con namedC [] cc), loc), st)
+              | DTable (s, n, c, s', pe, pc, ce, cc) => ((DTable (s, n, con namedC [] c, s',
+                                                                  exp (namedC, namedE) [] pe,
+                                                                  con namedC [] pc,
+                                                                  exp (namedC, namedE) [] ce,
+                                                                  con namedC [] cc), 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 19204ebb..378e8276 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -59,9 +59,10 @@ fun shake file =
         val (usedE, usedC, table_cs) =
             List.foldl
                 (fn ((DExport (_, n), _), (usedE, usedC, table_cs)) => (IS.add (usedE, n), usedE, table_cs)
-                  | ((DTable (_, _, c, _, e, _), _), (usedE, usedC, table_cs)) =>
+                  | ((DTable (_, _, c, _, pe, _, ce, _), _), (usedE, usedC, table_cs)) =>
                     let
-                        val (usedE, usedC) = usedVars (usedE, usedC) e
+                        val (usedE, usedC) = usedVars (usedE, usedC) pe
+                        val (usedE, usedC) = usedVars (usedE, usedC) ce
                     in
                         (usedE, usedC, c :: table_cs)
                     end
@@ -79,7 +80,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)))
diff --git a/src/source.sml b/src/source.sml
index 0dca39ab..3bd8e22a 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -88,7 +88,7 @@ datatype sgn_item' =
        | SgiDatatype of string * string list * (string * con option) list
        | SgiDatatypeImp of string * string list * string
        | SgiVal of string * con
-       | SgiTable of string * con * exp
+       | SgiTable of string * con * exp * exp
        | SgiStr of string * sgn
        | SgiSgn of string * sgn
        | SgiInclude of sgn
@@ -146,8 +146,6 @@ and pat = pat' located
 and exp = exp' located
 and edecl = edecl' located
 
-
-
 datatype decl' =
          DCon of string * kind option * con
        | DDatatype of string * string list * (string * con option) list
@@ -161,7 +159,7 @@ datatype decl' =
        | DConstraint of con * con
        | DOpenConstraints of string * string list
        | DExport of str
-       | DTable of string * con * exp
+       | DTable of string * con * exp * 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 c145dc63..94a175ac 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -417,17 +417,21 @@ fun p_sgn_item (sgi, _) =
                               string ":",
                               space,
                               p_con c]
-      | SgiTable (x, c, e) => box [string "table",
-                                space,
-                                string x,
-                                space,
-                                string ":",
-                                space,
-                                p_con c,
-                                space,
-                                string "constraints",
-                                space,
-                                p_exp e]
+      | SgiTable (x, c, pe, ce) => box [string "table",
+                                        space,
+                                        string x,
+                                        space,
+                                        string ":",
+                                        space,
+                                        p_con c,
+                                        space,
+                                        string "keys",
+                                        space,
+                                        p_exp pe,
+                                        space,
+                                        string "constraints",
+                                        space,
+                                        p_exp ce]
       | SgiStr (x, sgn) => box [string "structure",
                                 space,
                                 string x,
@@ -599,17 +603,21 @@ fun p_decl ((d, _) : decl) =
       | DExport str => box [string "export",
                             space,
                             p_str str]
-      | DTable (x, c, e) => box [string "table",
-                                 space,
-                                 string x,
-                                 space,
-                                 string ":",
-                                 space,
-                                 p_con c,
-                                 space,
-                                 string "constraints",
-                                 space,
-                                 p_exp e]
+      | DTable (x, c, pe, ce) => box [string "table",
+                                      space,
+                                      string x,
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_con c,
+                                      space,
+                                      string "keys",
+                                      space,
+                                      p_exp pe,
+                                      space,
+                                      string "constraints",
+                                      space,
+                                      p_exp ce]
       | DSequence x => box [string "sequence",
                             space,
                             string x]
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)
diff --git a/src/urweb.lex b/src/urweb.lex
index 735d230d..31c0a362 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -367,6 +367,8 @@ notags = [^<{\n]+;
 
 <INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
 <INITIAL> "UNIQUE"    => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));
+<INITIAL> "PRIMARY"   => (Tokens.PRIMARY (pos yypos, pos yypos + size yytext));
+<INITIAL> "KEY"       => (Tokens.KEY (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));