SQL sequences

32 files changed, 324 insertions, 13 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 9b6765dc..8dca6b46 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -87,6 +87,8 @@ datatype exp' =
                      prepared : int option }
        | EDml of { dml : exp,
                    prepared : int option }
+       | ENextval of { seq : exp,
+                       prepared : int option }
 
 withtype exp = exp' located
 
@@ -99,6 +101,7 @@ datatype decl' =
        | DFunRec of (string * int * (string * typ) list * typ * exp) list
 
        | DTable of string * (string * typ) list
+       | DSequence of string
        | DDatabase of string
        | DPreparedStatements of (string * int) list
 
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index fc4833da..49e86140 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -163,6 +163,7 @@ fun declBinds env (d, loc) =
                       pushENamed env fx n t
                   end) env vis
       | DTable _ => env
+      | DSequence _ => env
       | DDatabase _ => env
       | DPreparedStatements _ => env
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index f784f3d4..fdd02a3b 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -976,6 +976,87 @@ fun p_exp' par env (e, loc) =
              newline,
              string "}))"]
 
+      | ENextval {seq, prepared} =>
+        let
+            val query = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
+            val query = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), query]), loc)
+        in
+            box [string "(uw_begin_region(ctx), ",
+                 string "({",
+                 newline,
+                 string "PGconn *conn = uw_get_db(ctx);",
+                 newline,
+                 case prepared of
+                     NONE => box [string "char *query = ",
+                                  p_exp env query,
+                                  string ";",
+                                  newline]
+                   | SOME _ =>
+                     box [],
+                 newline,
+                 string "PGresult *res = ",
+                 case prepared of
+                     NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
+                   | SOME n => box [string "PQexecPrepared(conn, \"uw",
+                                    string (Int.toString n),
+                                    string "\", 0, NULL, NULL, NULL, 0);"],
+                 newline,
+                 string "uw_Basis_int n;",
+                 newline,
+                 newline,
+
+                 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
+                 newline,
+                 newline,
+
+                 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+                 newline,
+                 box [string "PQclear(res);",
+                      newline,
+                      string "uw_error(ctx, FATAL, \"",
+                      string (ErrorMsg.spanToString loc),
+                      string ": Query failed:\\n%s\\n%s\", ",
+                      case prepared of
+                          NONE => string "query"
+                        | SOME _ => p_exp env query,
+                      string ", PQerrorMessage(conn));",
+                      newline],
+                 string "}",
+                 newline,
+                 newline,
+
+                 string "uw_end_region(ctx);",
+                 newline,
+                 string "n = PQntuples(res);",
+                 newline,
+                 string "if (n != 1) {",
+                 newline,
+                 box [string "PQclear(res);",
+                      newline,
+                      string "uw_error(ctx, FATAL, \"",
+                      string (ErrorMsg.spanToString loc),
+                      string ": Wrong number of result rows:\\n%s\\n%s\", ",
+                      case prepared of
+                          NONE => string "query"
+                        | SOME _ => p_exp env query,
+                      string ", PQerrorMessage(conn));",
+                      newline],
+                 string "}",
+                 newline,
+                 newline,
+
+                 string "n = ",
+                 p_unsql true env (TFfi ("Basis", "int"), loc)
+                         (string "PQgetvalue(res, 0, 0)"),
+                 string ";",
+                 newline,
+                 string "PQclear(res);",
+                 newline,
+                 string "n;",
+                 newline,
+                 string "}))"]
+        end
+
 and p_exp env = p_exp' false env
 
 fun p_fun env (fx, n, args, ran, e) =
@@ -1119,6 +1200,10 @@ fun p_decl env (dAll as (d, _) : decl) =
                               string x,
                               string " */",
                               newline]
+      | DSequence x => box [string "/* SQL sequence ",
+                            string x,
+                            string " */",
+                            newline]
       | DDatabase s => box [string "static void uw_db_validate(uw_context);",
                             newline,
                             string "static void uw_db_prepare(uw_context);",
@@ -1938,6 +2023,12 @@ fun p_sql env (ds, _) =
                                                  string ");",
                                                  newline,
                                                  newline]
+                                          | DSequence s =>
+                                            box [string "CREATE SEQUENCE ",
+                                                 string s,
+                                                 string ";",
+                                                 newline,
+                                                 newline]
                                           | _ => box []
                            in
                                (pp, E.declBinds env dAll)
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 9e426751..606be3eb 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -388,6 +388,13 @@ fun cifyExp (eAll as (e, loc), sm) =
             ((L'.EDml {dml = e, prepared = NONE}, loc), sm)
         end
 
+      | L.ENextval e =>
+        let
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.ENextval {seq = e, prepared = NONE}, loc), sm)
+        end
+
 
 fun cifyDecl ((d, loc), sm) =
     case d of
@@ -490,6 +497,8 @@ fun cifyDecl ((d, loc), sm) =
         in
             (SOME (L'.DTable (s, xts), loc), NONE, sm)
         end
+      | L.DSequence s =>
+        (SOME (L'.DSequence s, loc), NONE, sm)
       | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm)
 
 fun cjrize ds =
diff --git a/src/core.sml b/src/core.sml
index 0eef7e96..1fcf26c4 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -115,6 +115,7 @@ datatype decl' =
        | DValRec of (string * int * con * exp * string) list
        | DExport of export_kind * int
        | DTable of string * int * con * string
+       | DSequence of string * int * string
        | DDatabase of string
 
 withtype decl = decl' located
diff --git a/src/core_env.sml b/src/core_env.sml
index a4d5fc50..a4b48b8d 100644
--- a/src/core_env.sml
+++ b/src/core_env.sml
@@ -217,7 +217,13 @@ fun declBinds env (d, loc) =
       | DExport _ => env
       | DTable (x, n, c, s) =>
         let
-            val t = (CApp ((CFfi ("Basis", "table"), loc), c), loc)
+            val t = (CApp ((CFfi ("Basis", "sql_table"), loc), c), loc)
+        in
+            pushENamed env x n t NONE s
+        end
+      | DSequence (x, n, s) =>
+        let
+            val t = (CFfi ("Basis", "sql_sequence"), loc)
         in
             pushENamed env x n t NONE s
         end
diff --git a/src/core_print.sml b/src/core_print.sml
index cfd01e2d..6e32dde3 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -458,6 +458,13 @@ fun p_decl env (dAll as (d, _) : decl) =
                                     string ":",
                                     space,
                                     p_con env c]
+      | DSequence (x, n, s) => box [string "sequence",
+                                    space,
+                                    p_named x n,
+                                    space,
+                                    string "as",
+                                    space,
+                                    string s]
       | DDatabase s => box [string "database",
                             space,
                             string s]
diff --git a/src/core_util.sml b/src/core_util.sml
index dfd6fa77..9b6b7d39 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -631,6 +631,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
                 S.map2 (mfc ctx c,
                         fn c' =>
                            (DTable (x, n, c', s), loc))
+              | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
 
         and mfvi ctx (x, n, t, e, s) =
@@ -716,7 +717,13 @@ fun mapfoldB (all as {bind, ...}) =
                                       | DExport _ => ctx
                                       | DTable (x, n, c, s) =>
                                         let
-                                            val t = (CApp ((CFfi ("Basis", "table"), #2 d'), c), #2 d')
+                                            val t = (CApp ((CFfi ("Basis", "sql_table"), #2 d'), c), #2 d')
+                                        in
+                                            bind (ctx, NamedE (x, n, t, NONE, s))
+                                        end
+                                      | DSequence (x, n, s) =>
+                                        let
+                                            val t = (CFfi ("Basis", "sql_sequence"), #2 d')
                                         in
                                             bind (ctx, NamedE (x, n, t, NONE, s))
                                         end
@@ -770,6 +777,7 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
                           | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
                           | DExport _ => count
                           | DTable (_, n, _, _) => Int.max (n, count)
+                          | DSequence (_, n, _) => Int.max (n, count)
                           | DDatabase _ => count) 0
               
 end
diff --git a/src/corify.sml b/src/corify.sml
index fac83ee3..92c429ef 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -863,6 +863,13 @@ fun corifyDecl ((d, loc : EM.span), st) =
         in
             ([(L'.DTable (x, n, corifyCon st c, s), loc)], st)
         end
+      | L.DSequence (_, x, n) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = x
+        in
+            ([(L'.DSequence (x, n, s), loc)], st)
+        end
 
       | L.DDatabase s => ([(L'.DDatabase s, loc)], st)
 
@@ -917,6 +924,7 @@ fun maxName ds = foldl (fn ((d, _), n) =>
                              | L.DFfiStr (_, n', _) => Int.max (n, n')
                              | L.DExport _ => n
                              | L.DTable (_, _, n', _) => Int.max (n, n')
+                             | L.DSequence (_, _, n') => Int.max (n, n')
                              | L.DDatabase _ => n)
                        0 ds
 
diff --git a/src/elab.sml b/src/elab.sml
index 6fcb857a..2e8d12f6 100644
--- a/src/elab.sml
+++ b/src/elab.sml
@@ -129,6 +129,7 @@ datatype sgn_item' =
        | SgiSgn of string * int * sgn
        | SgiConstraint of con * con
        | SgiTable of int * string * int * con
+       | SgiSequence of int * string * int
        | SgiClassAbs of string * int
        | SgiClass of string * int * con
 
@@ -155,6 +156,7 @@ datatype decl' =
        | DConstraint of con * con
        | DExport of int * sgn * str
        | DTable of int * string * int * con
+       | DSequence of int * string * int
        | DClass of string * int * con
        | DDatabase of string
 
diff --git a/src/elab_env.sml b/src/elab_env.sml
index 6c3d7802..3f32ed21 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -546,6 +546,7 @@ fun sgiSeek (sgi, (sgns, strs, cons)) =
       | SgiStr (x, n, _) => (sgns, IM.insert (strs, n, x), cons)
       | SgiConstraint _ => (sgns, strs, cons)
       | SgiTable _ => (sgns, strs, cons)
+      | SgiSequence _ => (sgns, strs, cons)
       | SgiClassAbs (x, n) => (sgns, strs, IM.insert (cons, n, x))
       | SgiClass (x, n, _) => (sgns, strs, IM.insert (cons, n, x))
 
@@ -835,7 +836,13 @@ fun sgiBinds env (sgi, loc) =
 
       | SgiTable (tn, x, n, c) =>
         let
-            val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc)
+            val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
+        in
+            pushENamedAs env x n t
+        end
+      | SgiSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
         in
             pushENamedAs env x n t
         end
@@ -975,6 +982,7 @@ fun sgnSeekConstraints (str, sgis) =
                   | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons, acc)
                   | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons, acc)
                   | SgiTable _ => seek (sgis, sgns, strs, cons, acc)
+                  | SgiSequence _ => seek (sgis, sgns, strs, cons, acc)
                   | SgiClassAbs (x, n) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
                   | SgiClass (x, n, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
     in
@@ -1049,7 +1057,13 @@ fun declBinds env (d, loc) =
       | DExport _ => env
       | DTable (tn, x, n, c) =>
         let
-            val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc)
+            val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
+        in
+            pushENamedAs env x n t
+        end
+      | DSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
         in
             pushENamedAs env x n t
         end
diff --git a/src/elab_print.sml b/src/elab_print.sml
index bb1c2a85..4dc41ca7 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -466,6 +466,9 @@ fun p_sgn_item env (sgi, _) =
                                       string ":",
                                       space,
                                       p_con env c]
+      | SgiSequence (_, x, n) => box [string "sequence",
+                                      space,
+                                      p_named x n]
       | SgiClassAbs (x, n) => box [string "class",
                                    space,
                                    p_named x n]
@@ -632,6 +635,9 @@ fun p_decl env (dAll as (d, _) : decl) =
                                     string ":",
                                     space,
                                     p_con env c]
+      | DSequence (_, x, n) => box [string "sequence",
+                                    space,
+                                    p_named x n]
       | DClass (x, n, c) => box [string "class",
                                  space,
                                  p_named x n,
diff --git a/src/elab_util.sml b/src/elab_util.sml
index 242ffdbc..02b95130 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -465,6 +465,7 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} =
                 S.map2 (con ctx c,
                         fn c' =>
                            (SgiTable (tn, x, n, c'), loc))
+              | SgiSequence _ => S.return2 siAll
               | SgiClassAbs _ => S.return2 siAll
               | SgiClass (x, n, c) =>
                 S.map2 (con ctx c,
@@ -494,6 +495,7 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} =
                                                    bind (ctx, Sgn (x, sgn))
                                                  | SgiConstraint _ => ctx
                                                  | SgiTable _ => ctx
+                                                 | SgiSequence _ => ctx
                                                  | SgiClassAbs (x, n) =>
                                                    bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc)))
                                                  | SgiClass (x, n, _) =>
@@ -635,8 +637,10 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
                                                  | DConstraint _ => ctx
                                                  | DExport _ => ctx
                                                  | DTable (tn, x, n, c) =>
-                                                   bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "table"), loc),
+                                                   bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "sql_table"), loc),
                                                                                 c), loc)))
+                                                 | DSequence (tn, x, n) =>
+                                                   bind (ctx, NamedE (x, (CModProj (n, [], "sql_sequence"), loc)))
                                                  | DClass (x, n, _) =>
                                                    bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc)))
                                                  | DDatabase _ => ctx,
@@ -731,13 +735,14 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
                 S.map2 (mfc ctx c,
                         fn c' =>
                            (DTable (tn, x, n, c'), loc))
+              | DSequence _ => S.return2 dAll
 
-             | DClass (x, n, c) =>
+              | DClass (x, n, c) =>
                 S.map2 (mfc ctx c,
-                        fn c' =>
-                           (DClass (x, n, c'), loc))
+                     fn c' =>
+                        (DClass (x, n, c'), loc))
 
-             | DDatabase _ => S.return2 dAll
+              | DDatabase _ => S.return2 dAll
 
         and mfvi ctx (x, n, c, e) =
             S.bind2 (mfc ctx c,
diff --git a/src/elaborate.sml b/src/elaborate.sml
index e6e5453d..0c313f14 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1648,6 +1648,7 @@ fun elabExp (env, denv) (eAll as (e, loc)) =
 val hnormSgn = E.hnormSgn
 
 fun tableOf () = (L'.CModProj (!basis_r, [], "sql_table"), ErrorMsg.dummySpan)
+fun sequenceOf () = (L'.CModProj (!basis_r, [], "sql_sequence"), ErrorMsg.dummySpan)
 
 fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
     case sgi of
@@ -1828,6 +1829,13 @@ fun elabSgn_item ((sgi, loc), (env, denv, gs)) =
             ([(L'.SgiTable (!basis_r, x, n, c'), loc)], (env, denv, gs))
         end
 
+      | L.SgiSequence x =>
+        let
+            val (env, n) = E.pushENamed env x (sequenceOf ())
+        in
+            ([(L'.SgiSequence (!basis_r, x, n), loc)], (env, denv, gs))
+        end
+
       | L.SgiClassAbs x =>
         let
             val k = (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)
@@ -1915,6 +1923,12 @@ and elabSgn (env, denv) (sgn, loc) =
                                    else
                                        ();
                                    (cons, SS.add (vals, x), sgns, strs))
+                                | L'.SgiSequence (_, x, _) =>
+                                  (if SS.member (vals, x) then
+                                       sgnError env (DuplicateVal (loc, x))
+                                   else
+                                       ();
+                                   (cons, SS.add (vals, x), sgns, strs))
                                 | L'.SgiClassAbs (x, _) =>
                                   (if SS.member (cons, x) then
                                        sgnError env (DuplicateCon (loc, x))
@@ -2061,6 +2075,9 @@ fun dopen (env, denv) {str, strs, sgn} =
                                             | L'.SgiTable (_, x, n, c) =>
                                               (L'.DVal (x, n, (L'.CApp (tableOf (), c), loc),
                                                         (L'.EModProj (str, strs, x), loc)), loc)
+                                            | L'.SgiSequence (_, x, n) =>
+                                              (L'.DVal (x, n, sequenceOf (),
+                                                        (L'.EModProj (str, strs, x), loc)), loc)
                                             | L'.SgiClassAbs (x, n) =>
                                               let
                                                   val k = (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)
@@ -2128,6 +2145,7 @@ fun sgiOfDecl (d, loc) =
       | L'.DConstraint cs => [(L'.SgiConstraint cs, loc)]
       | L'.DExport _ => []
       | L'.DTable (tn, x, n, c) => [(L'.SgiTable (tn, x, n, c), loc)]
+      | L'.DSequence (tn, x, n) => [(L'.SgiSequence (tn, x, n), loc)]
       | L'.DClass (x, n, c) => [(L'.SgiClass (x, n, c), loc)]
       | L'.DDatabase _ => []
 
@@ -2355,6 +2373,16 @@ fun subSgn (env, denv) sgn1 (sgn2 as (_, loc2)) =
                                                  SOME (env, denv))
                                      else
                                          NONE
+                                   | L'.SgiSequence (_, x', n1) =>
+                                     if x = x' then
+                                         (case unifyCons (env, denv) (sequenceOf ()) c2 of
+                                              [] => SOME (env, denv)
+                                            | _ => NONE)
+                                         handle CUnify (c1, c2, err) =>
+                                                (sgnError env (SgiWrongCon (sgi1All, c1, sgi2All, c2, err));
+                                                 SOME (env, denv))
+                                     else
+                                         NONE
                                    | _ => NONE)
 
                       | L'.SgiStr (x, n2, sgn2) =>
@@ -2432,6 +2460,16 @@ fun subSgn (env, denv) sgn1 (sgn2 as (_, loc2)) =
                                          NONE
                                    | _ => NONE)
 
+                      | L'.SgiSequence (_, x, n2) =>
+                        seek (fn sgi1All as (sgi1, _) =>
+                                 case sgi1 of
+                                     L'.SgiSequence (_, x', n1) =>
+                                     if x = x' then
+                                         SOME (env, denv)
+                                     else
+                                         NONE
+                                   | _ => NONE)
+
                       | L'.SgiClassAbs (x, n2) =>
                         seek (fn sgi1All as (sgi1, _) =>
                                  let
@@ -3024,6 +3062,12 @@ fun elabDecl (dAll as (d, loc), (env, denv, gs : constraint list)) =
                     checkKind env c' k (L'.KRecord (L'.KType, loc), loc);
                     ([(L'.DTable (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs))
                 end
+              | L.DSequence x =>
+                let
+                    val (env, n) = E.pushENamed env x (sequenceOf ())
+                in
+                    ([(L'.DSequence (!basis_r, x, n), loc)], (env, denv, gs))
+                end
 
               | L.DClass (x, c) =>
                 let
@@ -3147,6 +3191,16 @@ and elabStr (env, denv) (str, loc) =
                               in
                                   ((L'.SgiTable (tn, x, n, c), loc) :: sgis, cons, vals, sgns, strs)
                               end
+                            | L'.SgiSequence (tn, x, n) =>
+                              let
+                                  val (vals, x) =
+                                      if SS.member (vals, x) then
+                                          (vals, "?" ^ x)
+                                      else
+                                          (SS.add (vals, x), x)
+                              in
+                                  ((L'.SgiSequence (tn, x, n), loc) :: sgis, cons, vals, sgns, strs)
+                              end
                             | L'.SgiClassAbs (x, n) =>
                               let
                                   val k = (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)
diff --git a/src/expl.sml b/src/expl.sml
index 3bb7beff..c55461fc 100644
--- a/src/expl.sml
+++ b/src/expl.sml
@@ -108,6 +108,7 @@ datatype sgn_item' =
        | SgiSgn of string * int * sgn
        | SgiStr of string * int * sgn
        | SgiTable of int * string * int * con
+       | SgiSequence of int * string * int
 
 and sgn' =
     SgnConst of sgn_item list
@@ -130,6 +131,7 @@ datatype decl' =
        | DFfiStr of string * int * sgn
        | DExport of int * sgn * str
        | DTable of int * string * int * con
+       | DSequence of int * string * int
        | DDatabase of string
 
      and str' =
diff --git a/src/expl_env.sml b/src/expl_env.sml
index fdb4d995..43456c41 100644
--- a/src/expl_env.sml
+++ b/src/expl_env.sml
@@ -284,7 +284,13 @@ fun declBinds env (d, loc) =
       | DExport _ => env
       | DTable (tn, x, n, c) =>
         let
-            val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc)
+            val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
+        in
+            pushENamed env x n t
+        end
+      | DSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
         in
             pushENamed env x n t
         end
@@ -337,7 +343,13 @@ fun sgiBinds env (sgi, loc) =
 
       | SgiTable (tn, x, n, c) =>
         let
-            val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc)
+            val t = (CApp ((CModProj (tn, [], "sql_table"), loc), c), loc)
+        in
+            pushENamed env x n t
+        end
+      | SgiSequence (tn, x, n) =>
+        let
+            val t = (CModProj (tn, [], "sql_sequence"), loc)
         in
             pushENamed env x n t
         end
diff --git a/src/expl_print.sml b/src/expl_print.sml
index 10819fbc..dd328bb5 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -436,6 +436,9 @@ fun p_sgn_item env (sgi, _) =
                                       string ":",
                                       space,
                                       p_con env c]
+      | SgiSequence (_, x, n) => box [string "sequence",
+                                      space,
+                                      p_named x n]
 
 and p_sgn env (sgn, loc) =
     case sgn of
@@ -584,6 +587,9 @@ fun p_decl env (dAll as (d, _) : decl) =
                                     string ":",
                                     space,
                                     p_con env c]
+      | DSequence (_, x, n) => box [string "sequence",
+                                    space,
+                                    p_named x n]
       | DDatabase s => box [string "database",
                             space,
                             string s]
diff --git a/src/expl_util.sml b/src/expl_util.sml
index ee4b6dc2..b8376b5b 100644
--- a/src/expl_util.sml
+++ b/src/expl_util.sml
@@ -416,6 +416,7 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} =
                 S.map2 (con ctx c,
                         fn c' =>
                            (SgiTable (tn, x, n, c'), loc))
+              | SgiSequence _ => S.return2 siAll
 
         and sg ctx s acc =
             S.bindP (sg' ctx s acc, sgn ctx)
@@ -438,7 +439,8 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} =
                                                    bind (ctx, Str (x, sgn))
                                                  | SgiSgn (x, _, sgn) =>
                                                    bind (ctx, Sgn (x, sgn))
-                                                 | SgiTable _ => ctx,
+                                                 | SgiTable _ => ctx
+                                                 | SgiSequence _ => ctx,
                                                sgi ctx si)) ctx sgis,
                      fn sgis' =>
                         (SgnConst sgis', loc))
diff --git a/src/explify.sml b/src/explify.sml
index 76ef9551..c45e7305 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -130,6 +130,7 @@ fun explifySgi (sgi, loc) =
       | L.SgiSgn (x, n, sgn) => SOME (L'.SgiSgn (x, n, explifySgn sgn), loc)
       | L.SgiConstraint _ => NONE
       | L.SgiTable (nt, x, n, c) => SOME (L'.SgiTable (nt, x, n, explifyCon c), loc)
+      | L.SgiSequence (nt, x, n) => SOME (L'.SgiSequence (nt, x, n), loc)
       | L.SgiClassAbs (x, n) => SOME (L'.SgiConAbs (x, n, (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)), loc)
       | L.SgiClass (x, n, c) => SOME (L'.SgiCon (x, n, (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc),
                                                  explifyCon c), loc)
@@ -162,6 +163,7 @@ fun explifyDecl (d, loc : EM.span) =
       | 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.DSequence (nt, x, n) => SOME (L'.DSequence (nt, x, n), loc)
       | L.DClass (x, n, c) => SOME (L'.DCon (x, n,
                                              (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc), explifyCon c), loc)
       | L.DDatabase s => SOME (L'.DDatabase s, loc)
diff --git a/src/mono.sml b/src/mono.sml
index b10f651c..4742c541 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -89,6 +89,7 @@ datatype exp' =
                      body : exp,
                      initial : exp }
        | EDml of exp
+       | ENextval of exp
 
 
 withtype exp = exp' located
@@ -100,6 +101,7 @@ datatype decl' =
        | DExport of Core.export_kind * string * int * typ list
 
        | DTable of string * (string * typ) list
+       | DSequence of string
        | DDatabase of string
 
 withtype decl = decl' located
diff --git a/src/mono_env.sml b/src/mono_env.sml
index 9981ec01..47ffd28d 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -108,6 +108,7 @@ fun declBinds env (d, loc) =
       | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis
       | DExport _ => env
       | DTable _ => env
+      | DSequence _ => env
       | DDatabase _ => env
 
 fun patBinds env (p, loc) =
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 40abf7d7..f7adfd70 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -260,6 +260,9 @@ fun p_exp' par env (e, _) =
       | EDml e => box [string "dml(",
                        p_exp env e,
                        string ")"]
+      | ENextval e => box [string "nextval(",
+                           p_exp env e,
+                           string ")"]
 
 and p_exp env = p_exp' false env
 
@@ -348,6 +351,9 @@ fun p_decl env (dAll as (d, _) : decl) =
                                                           p_typ env t]) xts,
                                 space,
                                 string "*)"]
+      | DSequence s => box [string "(* SQL sequence ",
+                            string s,
+                            string "*)"]
       | DDatabase s => box [string "database",
                             space,
                             string s]
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index b66e9b04..c7b727ee 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -40,6 +40,7 @@ fun impure (e, _) =
         EWrite _ => true
       | EQuery _ => true
       | EDml _ => true
+      | ENextval _ => true
       | EAbs _ => false
 
       | EPrim _ => false
@@ -250,6 +251,7 @@ fun summarize d (e, _) =
                      [ReadDb]]
 
       | EDml e => summarize d e @ [WriteDb]
+      | ENextval e => summarize d e @ [WriteDb]
 
 fun exp env e =
     case e of
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index dddb1d9a..6714718a 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -55,6 +55,7 @@ fun shake file =
                                      (cdef, foldl (fn ((_, n, t, e, _), edef) => IM.insert (edef, n, (t, e))) edef vis)
                                    | ((DExport _, _), acc) => acc
                                    | ((DTable _, _), acc) => acc
+                                   | ((DSequence _, _), acc) => acc
                                    | ((DDatabase _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
@@ -110,6 +111,7 @@ fun shake file =
                       | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
                       | (DExport _, _) => true
                       | (DTable _, _) => true
+                      | (DSequence _, _) => true
                       | (DDatabase _, _) => true) file
     end
 
diff --git a/src/mono_util.sml b/src/mono_util.sml
index e9f8e033..a56e5287 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -290,6 +290,10 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (EDml e', loc))
+              | ENextval e =>
+                S.map2 (mfe ctx e,
+                     fn e' =>
+                        (ENextval e', loc))
     in
         mfe
     end
@@ -375,6 +379,7 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
                         fn ts' =>
                            (DExport (ek, s, n, ts'), loc))
               | DTable _ => S.return2 dAll
+              | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
 
         and mfvi ctx (x, n, t, e, s) =
@@ -439,6 +444,7 @@ fun mapfoldB (all as {bind, ...}) =
                                                                  bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis
                                       | DExport _ => ctx
                                       | DTable _ => ctx
+                                      | DSequence _ => ctx
                                       | DDatabase _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
diff --git a/src/monoize.sml b/src/monoize.sml
index e750c381..13feae36 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -106,6 +106,8 @@ fun monoType env =
                     (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
                   | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "sql_sequence") =>
+                    (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) =>
@@ -1151,6 +1153,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
           | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
 
+          | L.EFfiApp ("Basis", "nextval", [e]) =>
+            let
+                val un = (L'.TRecord [], loc)
+                val int = (L'.TFfi ("Basis", "int"), loc)
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EAbs ("_", un, int,
+                           (L'.ENextval (liftExpInExp 0 e), loc)), loc),
+                 fm)
+            end
+
           | L.EApp (
             (L.ECApp (
              (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
@@ -1618,6 +1631,18 @@ fun monoDecl (env, fm) (all as (d, loc)) =
                        (L'.DVal (x, n, t', e, s), loc)])
             end
           | L.DTable _ => poly ()
+          | L.DSequence (x, n, s) =>
+            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)
+            in
+                SOME (Env.pushENamed env x n t NONE s,
+                      fm,
+                      [(L'.DSequence s, loc),
+                       (L'.DVal (x, n, t', e, s), loc)])
+            end
           | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)])
     end
 
diff --git a/src/prepare.sml b/src/prepare.sml
index 20a09c9b..3c5aa2aa 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -163,6 +163,18 @@ fun prepExp (e as (_, loc), sns) =
              ((EDml {dml = dml, prepared = SOME (#2 sns)}, loc),
               ((String.concat (rev ss), n) :: #1 sns, #2 sns + 1)))
 
+      | ENextval {seq, ...} =>
+        let
+            val s = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
+            val s = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), s]), loc)
+        in
+            case prepString (s, [], 0) of
+                NONE => (e, sns)
+              | SOME (ss, n) =>
+                ((ENextval {seq = seq, prepared = SOME (#2 sns)}, loc),
+                 ((String.concat (rev ss), n) :: #1 sns, #2 sns + 1))
+        end
+
 fun prepDecl (d as (_, loc), sns) =
     case #1 d of
         DStruct _ => (d, sns)
@@ -193,6 +205,7 @@ fun prepDecl (d as (_, loc), sns) =
         end
 
       | DTable _ => (d, sns)
+      | DSequence _ => (d, sns)
       | DDatabase _ => (d, sns)
       | DPreparedStatements _ => (d, sns)
 
diff --git a/src/shake.sml b/src/shake.sml
index 6395bfdc..38d72cc5 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -41,6 +41,7 @@ type free = {
      exp : IS.set
 }
 
+val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan)
 val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan)
 
 fun shake file =
@@ -60,6 +61,8 @@ fun shake file =
                                    | ((DExport _, _), acc) => acc
                                    | ((DTable (_, n, c, _), _), (cdef, edef)) =>
                                      (cdef, IM.insert (edef, n, (c, dummye)))
+                                   | ((DSequence (_, n, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, (dummyt, dummye)))
                                    | ((DDatabase _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
@@ -116,6 +119,7 @@ fun shake file =
                       | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
                       | (DExport _, _) => true
                       | (DTable _, _) => true
+                      | (DSequence _, _) => true
                       | (DDatabase _, _) => true) file
     end
 
diff --git a/src/source.sml b/src/source.sml
index 70738c1a..bfb54194 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -83,6 +83,7 @@ datatype sgn_item' =
        | SgiInclude of sgn
        | SgiConstraint of con * con
        | SgiTable of string * con
+       | SgiSequence of string
        | SgiClassAbs of string
        | SgiClass of string * con
 
@@ -141,6 +142,7 @@ datatype decl' =
        | DOpenConstraints of string * string list
        | DExport of str
        | DTable of string * con
+       | DSequence of string
        | DClass of string * con
        | DDatabase of string
 
diff --git a/src/source_print.sml b/src/source_print.sml
index c37505d0..4844e508 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -380,6 +380,9 @@ fun p_sgn_item (sgi, _) =
                                 string ":",
                                 space,
                                 p_con c]
+      | SgiSequence x => box [string "sequence",
+                              space,
+                              string x]
       | SgiClassAbs x => box [string "class",
                               space,
                               string x]
@@ -542,6 +545,9 @@ fun p_decl ((d, _) : decl) =
                               string ":",
                               space,
                               p_con c]
+      | DSequence x => box [string "sequence",
+                            space,
+                            string x]
       | DClass (x, c) => box [string "class",
                               space,
                               string x,
diff --git a/src/urweb.grm b/src/urweb.grm
index ff53b4b8..e9d081a5 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -173,7 +173,7 @@ fun tagIn bt =
  | ARROW | LARROW | DARROW | STAR | SEMI
  | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE
  | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN
- | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE
+ | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE
  | CASE | IF | THEN | ELSE
 
  | XML_BEGIN of string | XML_END
@@ -385,6 +385,7 @@ decl   : CON SYMBOL cargl2 kopt EQ cexp (let
        | 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))])
+       | SEQUENCE SYMBOL                ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
        | CLASS SYMBOL EQ cexp           ([(DClass (SYMBOL, cexp), s (CLASSleft, cexpright))])
        | CLASS SYMBOL SYMBOL EQ cexp    (let
                                              val loc = s (CLASSleft, cexpright)
@@ -463,6 +464,7 @@ sgi    : CON SYMBOL DCOLON kind         (SgiConAbs (SYMBOL, kind), s (CONleft, k
        | INCLUDE sgn                    (SgiInclude sgn, s (INCLUDEleft, sgnright))
        | CONSTRAINT cterm TWIDDLE cterm (SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))
        | TABLE SYMBOL COLON cexp        (SgiTable (SYMBOL, entable cexp), s (TABLEleft, cexpright))
+       | SEQUENCE SYMBOL                (SgiSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))
        | CLASS SYMBOL                   (SgiClassAbs SYMBOL, s (CLASSleft, SYMBOLright))
        | CLASS SYMBOL EQ cexp           (SgiClass (SYMBOL, cexp), s (CLASSleft, cexpright))
        | CLASS SYMBOL SYMBOL EQ cexp    (let
diff --git a/src/urweb.lex b/src/urweb.lex
index 9cb4d642..8d861082 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -298,6 +298,7 @@ notags = [^<{\n]+;
 <INITIAL> "constraints"=> (Tokens.CONSTRAINTS (pos yypos, pos yypos + size yytext));
 <INITIAL> "export"    => (Tokens.EXPORT (pos yypos, pos yypos + size yytext));
 <INITIAL> "table"     => (Tokens.TABLE (pos yypos, pos yypos + size yytext));
+<INITIAL> "sequence"  => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext));
 <INITIAL> "class"     => (Tokens.CLASS (pos yypos, pos yypos + size yytext));
 
 <INITIAL> "Type"      => (Tokens.TYPE (pos yypos, pos yypos + size yytext));