Demo working with MySQL

13 files changed, 347 insertions, 54 deletions

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 4b92c2b4..cf44686a 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1932,13 +1932,15 @@ char *uw_memdup(uw_context ctx, const char *p, size_t len) {
   return r;
 }
 
+char *uw_sqlfmtInt = "%lld::int8%n";
+
 char *uw_Basis_sqlifyInt(uw_context ctx, uw_Basis_int n) {
   int len;
   char *r;
 
   uw_check_heap(ctx, INTS_MAX + 6);
   r = ctx->heap.front;
-  sprintf(r, "%lld::int8%n", n, &len);
+  sprintf(r, uw_sqlfmtInt, n, &len);
   ctx->heap.front += len+1;
   return r;
 }
@@ -1950,13 +1952,15 @@ char *uw_Basis_sqlifyIntN(uw_context ctx, uw_Basis_int *n) {
     return uw_Basis_sqlifyInt(ctx, *n);
 }
 
+char *uw_sqlfmtFloat = "%g::float8%n";
+
 char *uw_Basis_sqlifyFloat(uw_context ctx, uw_Basis_float n) {
   int len;
   char *r;
 
   uw_check_heap(ctx, FLOATS_MAX + 8);
   r = ctx->heap.front;
-  sprintf(r, "%g::float8%n", n, &len);
+  sprintf(r, uw_sqlfmtFloat, n, &len);
   ctx->heap.front += len+1;
   return r;
 }
@@ -1968,14 +1972,17 @@ char *uw_Basis_sqlifyFloatN(uw_context ctx, uw_Basis_float *n) {
     return uw_Basis_sqlifyFloat(ctx, *n);
 }
 
+int uw_Estrings = 1;
+char *uw_sqlsuffixString = "::text";
 
 uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
   char *r, *s2;
 
-  uw_check_heap(ctx, strlen(s) * 2 + 10);
+  uw_check_heap(ctx, strlen(s) * 2 + 3 + uw_Estrings + strlen(uw_sqlsuffixString));
 
   r = s2 = ctx->heap.front;
-  *s2++ = 'E';
+  if (uw_Estrings)
+    *s2++ = 'E';
   *s2++ = '\'';
 
   for (; *s; s++) {
@@ -1993,26 +2000,32 @@ uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
     default:
       if (isprint(c))
         *s2++ = c;
-      else {
+      else if (uw_Estrings) {
         sprintf(s2, "\\%03o", c);
         s2 += 4;
       }
+      else
+        uw_error(ctx, FATAL, "Non-printable character %u in string to SQLify", c);
     }
   }
 
-  strcpy(s2, "'::text");
-  ctx->heap.front = s2 + 8;
+  *s2++ = '\'';
+  strcpy(s2, uw_sqlsuffixString);
+  ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixString);
   return r;
 }
 
+char *uw_sqlsuffixBlob = "::bytea";
+
 uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
   char *r, *s2;
   size_t i;
 
-  uw_check_heap(ctx, b.size * 5 + 11);
+  uw_check_heap(ctx, b.size * 5 + 3 + uw_Estrings + strlen(uw_sqlsuffixBlob));
 
   r = s2 = ctx->heap.front;
-  *s2++ = 'E';
+  if (uw_Estrings)
+    *s2++ = 'E';
   *s2++ = '\'';
 
   for (i = 0; i < b.size; ++i) {
@@ -2030,15 +2043,18 @@ uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
     default:
       if (isprint(c))
         *s2++ = c;
-      else {
+      else if (uw_Estrings) {
         sprintf(s2, "\\\\%03o", c);
         s2 += 5;
       }
+      else
+        uw_error(ctx, FATAL, "Non-printable character %u in blob to SQLify", c);
     }
   }
 
-  strcpy(s2, "'::bytea");
-  ctx->heap.front = s2 + 9;
+  *s2++ = '\'';
+  strcpy(s2, uw_sqlsuffixBlob);
+  ctx->heap.front = s2 + 1 + strlen(uw_sqlsuffixBlob);
   return r;
 }
 
@@ -2049,7 +2065,7 @@ char *uw_Basis_sqlifyChannel(uw_context ctx, uw_Basis_channel chn) {
 
   uw_check_heap(ctx, INTS_MAX + 7);
   r = ctx->heap.front;
-  sprintf(r, "%lld::int8%n", combo, &len);
+  sprintf(r, uw_sqlfmtInt, combo, &len);
   ctx->heap.front += len+1;
   return r;
 }
@@ -2066,13 +2082,15 @@ char *uw_Basis_attrifyChannel(uw_context ctx, uw_Basis_channel chn) {
   return r;
 }
 
+char *uw_sqlfmtUint4 = "%u::int4%n";
+
 char *uw_Basis_sqlifyClient(uw_context ctx, uw_Basis_client cli) {
   int len;
   char *r;
 
   uw_check_heap(ctx, INTS_MAX + 7);
   r = ctx->heap.front;
-  sprintf(r, "%u::int4%n", cli, &len);
+  sprintf(r, uw_sqlfmtUint4, cli, &len);
   ctx->heap.front += len+1;
   return r;
 }
diff --git a/src/checknest.sig b/src/checknest.sig
new file mode 100644
index 00000000..f8273b4f
--- /dev/null
+++ b/src/checknest.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CHECKNEST = sig
+
+    val annotate : Cjr.file -> Cjr.file
+
+end
diff --git a/src/checknest.sml b/src/checknest.sml
new file mode 100644
index 00000000..27a1796c
--- /dev/null
+++ b/src/checknest.sml
@@ -0,0 +1,178 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Checknest :> CHECKNEST = struct
+
+open Cjr
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
+fun expUses globals =
+    let
+        fun eu (e, _) =
+            case e of
+                EPrim _ => IS.empty
+              | ERel _ => IS.empty
+              | ENamed n => Option.getOpt (IM.find (globals, n), IS.empty)
+              | ECon (_, _, NONE) => IS.empty
+              | ECon (_, _, SOME e) => eu e
+              | ENone _ => IS.empty
+              | ESome (_, e) => eu e
+              | EFfi _ => IS.empty
+              | EFfiApp (_, _, es) => foldl IS.union IS.empty (map eu es)
+              | EApp (e, es) => foldl IS.union (eu e) (map eu es)
+
+              | EUnop (_, e) => eu e
+              | EBinop (_, e1, e2) => IS.union (eu e1, eu e2)
+
+              | ERecord (_, xes) => foldl (fn ((_, e), s) => IS.union (eu e, s)) IS.empty xes
+              | EField (e, _) => eu e
+
+              | ECase (e, pes, _) => foldl (fn ((_, e), s) => IS.union (eu e, s)) (eu e) pes
+
+              | EError (e, _) => eu e
+              | EReturnBlob {blob, mimeType, ...} => IS.union (eu blob, eu mimeType)
+
+              | EWrite e => eu e
+              | ESeq (e1, e2) => IS.union (eu e1, eu e2)
+              | ELet (_, _, e1, e2) => IS.union (eu e1, eu e2)
+
+              | EQuery {query, body, initial, prepared, ...} =>
+                let
+                    val s = IS.union (eu query, IS.union (eu body, eu initial))
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+              | EDml {dml, prepared, ...} =>
+                let
+                    val s = eu dml
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+              | ENextval {seq, prepared, ...} =>
+                let
+                    val s = eu seq
+                in
+                    case prepared of
+                        SOME {id, ...} => IS.add (s, id)
+                      | _ => s
+                end
+
+              | EUnurlify (e, _) => eu e
+    in
+        eu
+    end
+
+fun annotateExp globals =
+    let
+        fun ae (e as (_, loc)) =
+            case #1 e of
+                EPrim _ => e
+              | ERel _ => e
+              | ENamed n => e
+              | ECon (_, _, NONE) => e
+              | ECon (dk, pc, SOME e) => (ECon (dk, pc, SOME (ae e)), loc)
+              | ENone _ => e
+              | ESome (t, e) => (ESome (t, ae e), loc)
+              | EFfi _ => e
+              | EFfiApp (m, f, es) => (EFfiApp (m, f, map ae es), loc)
+              | EApp (e, es) => (EApp (ae e, map ae es), loc)
+
+              | EUnop (uo, e) => (EUnop (uo, ae e), loc)
+              | EBinop (bo, e1, e2) => (EBinop (bo, ae e1, ae e2), loc)
+
+              | ERecord (n, xes) => (ERecord (n, map (fn (x, e) => (x, ae e)) xes), loc)
+              | EField (e, f) => (EField (ae e, f), loc)
+
+              | ECase (e, pes, ts) => (ECase (ae e, map (fn (p, e) => (p, ae e)) pes, ts), loc)
+
+              | EError (e, t) => (EError (ae e, t), loc)
+              | EReturnBlob {blob, mimeType, t} => (EReturnBlob {blob = ae blob, mimeType = ae mimeType, t = t}, loc)
+
+              | EWrite e => (EWrite (ae e), loc)
+              | ESeq (e1, e2) => (ESeq (ae e1, ae e2), loc)
+              | ELet (x, t, e1, e2) => (ELet (x, t, ae e1, ae e2), loc)
+
+              | EQuery {exps, tables, rnum, state, query, body, initial, prepared} =>
+                (EQuery {exps = exps,
+                         tables = tables,
+                         rnum = rnum,
+                         state = state,
+                         query = ae query,
+                         body = ae body,
+                         initial = ae initial,
+                         prepared = case prepared of
+                                        NONE => NONE
+                                      | SOME {id, query, ...} => SOME {id = id, query = query,
+                                                                       nested = IS.member (expUses globals body, id)}},
+                 loc)
+              | EDml {dml, prepared} =>
+                (EDml {dml = ae dml,
+                       prepared = prepared}, loc)
+
+              | ENextval {seq, prepared} =>
+                (ENextval {seq = ae seq,
+                           prepared = prepared}, loc)
+
+              | EUnurlify (e, t) => (EUnurlify (ae e, t), loc)
+    in
+        ae
+    end
+
+fun annotate (ds, syms) =
+    let
+        val globals =
+            foldl (fn ((d, _), globals) =>
+                      case d of
+                          DVal (_, n, _, e) => IM.insert (globals, n, expUses globals e)
+                        | DFun (_, n, _, _, e) => IM.insert (globals, n, expUses globals e)
+                        | DFunRec fs =>
+                          let
+                              val s = foldl (fn ((_, _, _, _, e), s) => IS.union (expUses globals e, s)) IS.empty fs
+                          in
+                              foldl (fn ((_, n, _, _, _), globals) => IM.insert (globals, n, s)) globals fs
+                          end
+                        | _ => globals) IM.empty ds
+
+        val ds =
+            map (fn d as (_, loc) =>
+                    case #1 d of
+                        DVal (x, n, t, e) => (DVal (x, n, t, annotateExp globals e), loc)
+                      | DFun (x, n, ts, t, e) => (DFun (x, n, ts, t, annotateExp globals e), loc)
+                      | DFunRec fs => (DFunRec
+                                           (map (fn (x, n, ts, t, e) => (x, n, ts, t, annotateExp globals e)) fs), loc)
+                      | _ => d) ds
+    in
+        (ds, syms)
+    end
+
+end
diff --git a/src/cjr.sml b/src/cjr.sml
index a5931a55..8c4267f6 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -89,11 +89,11 @@ datatype exp' =
                      query : exp,
                      body : exp,
                      initial : exp,
-                     prepared : (int * string) option }
+                     prepared : {id : int, query : string, nested : bool} option }
        | EDml of { dml : exp,
-                   prepared : (int * string) option }
+                   prepared : {id : int, dml : string} option }
        | ENextval of { seq : exp,
-                       prepared : (int * string) option }
+                       prepared : {id : int, query : string} option }
        | EUnurlify of exp * typ
 
 withtype exp = exp' located
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 375cc4b8..3e4ccdd0 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1654,7 +1654,7 @@ fun p_exp' par env (e, loc) =
                                  {loc = loc,
                                   cols = map (fn (_, t) => sql_type_in env t) outputs,
                                   doCols = doCols}]
-                   | SOME (id, query) =>
+                   | SOME {id, query, nested} =>
                      box [p_list_sepi newline
                                       (fn i => fn (e, t) =>
                                                   box [p_sql_type t,
@@ -1676,7 +1676,8 @@ fun p_exp' par env (e, loc) =
                                           query = query,
                                           inputs = map #2 inputs,
                                           cols = map (fn (_, t) => sql_type_in env t) outputs,
-                                          doCols = doCols}],
+                                          doCols = doCols,
+                                          nested = nested}],
                  newline,
 
                  if wontLeakAnything then
@@ -1703,7 +1704,7 @@ fun p_exp' par env (e, loc) =
                               newline,
                               newline,
                               #dml (Settings.currentDbms ()) loc]
-               | SOME (id, dml') =>
+               | SOME {id, dml = dml'} =>
                  let
                      val inputs = getPargs dml
                  in
@@ -1748,7 +1749,7 @@ fun p_exp' par env (e, loc) =
                                                              seqName = case #1 seq of
                                                                            EPrim (Prim.String s) => SOME s
                                                                          | _ => NONE}
-               | SOME (id, query) => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
+               | SOME {id, query} => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
                                                                                  id = id,
                                                                                  query = query},
              newline,
diff --git a/src/compiler.sig b/src/compiler.sig
index f7727771..c36ae2cc 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -99,6 +99,7 @@ signature COMPILER = sig
     val cjrize : (Mono.file, Cjr.file) phase
     val scriptcheck : (Cjr.file, Cjr.file) phase
     val prepare : (Cjr.file, Cjr.file) phase
+    val checknest : (Cjr.file, Cjr.file) phase
     val sqlify : (Mono.file, Cjr.file) phase
 
     val toParseJob : (string, job) transform
@@ -138,6 +139,7 @@ signature COMPILER = sig
     val toCjrize : (string, Cjr.file) transform
     val toScriptcheck : (string, Cjr.file) transform
     val toPrepare : (string, Cjr.file) transform
+    val toChecknest : (string, Cjr.file) transform
     val toSqlify : (string, Cjr.file) transform
 
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index 9cf874c7..03454638 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -884,6 +884,13 @@ val prepare = {
 
 val toPrepare = transform prepare "prepare" o toScriptcheck
 
+val checknest = {
+    func = fn f => if #supportsNestedPrepared (Settings.currentDbms ()) then f else Checknest.annotate f,
+    print = CjrPrint.p_file CjrEnv.empty
+}
+
+val toChecknest = transform checknest "checknest" o toPrepare
+
 val sqlify = {
     func = Cjrize.cjrize,
     print = CjrPrint.p_sql CjrEnv.empty
@@ -924,7 +931,7 @@ fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
     end
 
 fun compile job =
-    case run toPrepare job of
+    case run toChecknest job of
         NONE => print "Ur compilation failed\n"
       | SOME file =>
         let
diff --git a/src/mysql.sml b/src/mysql.sml
index 439e8444..e6d42687 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2009, Adam Chlipala
+(* Copyright (c) 2009, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -376,7 +376,21 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
 
              string "void uw_client_init(void) {",
              newline,
-             box [string "if (mysql_library_init(0, NULL, NULL)) {",
+             box [string "uw_sqlfmtInt = \"%lld%n\";",
+                  newline,
+                  string "uw_sqlfmtFloat = \"%g%n\";",
+                  newline,
+                  string "uw_Estrings = 0;",
+                  newline,
+                  string "uw_sqlsuffixString = \"\";",
+                  newline,
+                  string "uw_sqlsuffixBlob = \"\";",
+                  newline,
+                  string "uw_sqlfmtUint4 = \"%u%n\";",
+                  newline,
+                  newline,
+
+                  string "if (mysql_library_init(0, NULL, NULL)) {",
                   newline,
                   box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
                        newline,
@@ -867,7 +881,7 @@ fun query {loc, cols, doCols} =
          string "uw_pop_cleanup(ctx);",
          newline]
 
-fun queryPrepared {loc, id, query, inputs, cols, doCols} =
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
          string "MYSQL_BIND in[",
@@ -901,18 +915,25 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols} =
                                                      | _ => buffers t,
                                                    newline]
                                           end) inputs,
-         string "MYSQL_STMT *stmt = conn->p",
-         string (Int.toString id),
-         string ";",
-         newline,
-         newline,
 
-         string "if (stmt == NULL) {",
-         newline,
+         if nested then
+             box [string "MYSQL_STMT *stmt;",
+                  newline]
+         else
+             box [string "MYSQL_STMT *stmt = conn->p",
+                  string (Int.toString id),
+                  string ";",
+                  newline,
+                  newline,
+
+                  string "if (stmt == NULL) {",
+                  newline],
+
          box [string "stmt = mysql_stmt_init(conn->conn);",
               newline,
               string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
               newline,
+              string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
               string "if (mysql_stmt_prepare(stmt, \"",
               string (String.toString query),
               string "\", ",
@@ -929,12 +950,18 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols} =
                    newline],
               string "}",
               newline,
-              string "conn->p",
-              string (Int.toString id),
-              string " = stmt;",
-              newline],
-         string "}",
-         newline,
+              if nested then
+                  box []
+              else
+                  box [string "conn->p",
+                       string (Int.toString id),
+                       string " = stmt;",
+                       newline]],
+         if nested then
+             box []
+         else
+             box [string "}",
+                  newline],
          newline,
 
          string "memset(in, 0, sizeof in);",
@@ -1086,7 +1113,13 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols} =
 
          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
                                                                             string (String.toString query),
-                                                                            string "\""]}]
+                                                                            string "\""]},
+
+         if nested then
+             box [string "uw_pop_cleanup(ctx);",
+                  newline]
+         else
+             box []]
 
 fun dmlCommon {loc, dml} =
     box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
@@ -1402,6 +1435,7 @@ val () = addDbms {name = "mysql",
                   supportsDeleteAs = false,
                   createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTO_INCREMENT)",
                   textKeysNeedLengths = true,
-                  supportsNextval = false}
+                  supportsNextval = false,
+                  supportsNestedPrepared = false}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index 24166258..e1ef0514 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -247,7 +247,21 @@ fun checkRel (table, checkNullable) (s, xts) =
 
 fun init {dbstring, prepared = ss, tables, views, sequences} =
     box [if #persistent (currentProtocol ()) then
-             box [string "void uw_client_init(void) { }",
+             box [string "void uw_client_init(void) {",
+                  newline,
+                  box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
+                       newline,
+                       string "uw_sqlfmtFloat = \"%g::float8%n\";",
+                       newline,
+                       string "uw_Estrings = 1;",
+                       newline,
+                       string "uw_sqlsuffixString = \"::text\";",
+                       newline,
+                       string "uw_sqlsuffixBlob = \"::bytea\";",
+                       newline,
+                       string "uw_sqlfmtUint4 = \"%u::int4%n\";",
+                       newline],
+                  string "}",
                   newline,
                   newline,
 
@@ -639,7 +653,7 @@ fun p_ensql t e =
                            p_ensql t (box [string "(*", e, string ")"]),
                            string ")"]
 
-fun queryPrepared {loc, id, query, inputs, cols, doCols} =
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
     box [string "PGconn *conn = uw_get_db(ctx);",
          newline,
          string "const int paramFormats[] = { ",
@@ -782,8 +796,6 @@ fun nextvalCommon {loc, query} =
          newline,
          newline,
 
-         string "uw_end_region(ctx);",
-         newline,
          string "n = PQntuples(res);",
          newline,
          string "if (n != 1) {",
@@ -811,7 +823,7 @@ fun nextval {loc, seqE, seqName} =
     let
         val query = case seqName of
                         SOME s =>
-                        string ("SELECT NEXTVAL('" ^ s ^ "')")
+                        string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
                       | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
                                   seqE,
                                   string ", \"')\"))"]
@@ -878,7 +890,8 @@ val () = addDbms {name = "postgres",
                   supportsDeleteAs = true,
                   createSequence = fn s => "CREATE SEQUENCE " ^ s,
                   textKeysNeedLengths = false,
-                  supportsNextval = true}
+                  supportsNextval = true,
+                  supportsNestedPrepared = true}
 
 val () = setDbms "postgres"
 
diff --git a/src/prepare.sml b/src/prepare.sml
index 29def780..2bf23d72 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -199,7 +199,7 @@ fun prepExp (e as (_, loc), sns) =
                 in
                     ((EQuery {exps = exps, tables = tables, rnum = rnum,
                               state = state, query = query, body = body,
-                              initial = initial, prepared = SOME (#2 sns, s)}, loc),
+                              initial = initial, prepared = SOME {id = #2 sns, query = s, nested = true}}, loc),
                      ((s, n) :: #1 sns, #2 sns + 1))
                 end
         end
@@ -211,7 +211,7 @@ fun prepExp (e as (_, loc), sns) =
              let
                  val s = String.concat (rev ss)
              in
-                 ((EDml {dml = dml, prepared = SOME (#2 sns, s)}, loc),
+                 ((EDml {dml = dml, prepared = SOME {id = #2 sns, dml = s}}, loc),
                   ((s, n) :: #1 sns, #2 sns + 1))
              end)
 
@@ -234,7 +234,7 @@ fun prepExp (e as (_, loc), sns) =
                     let
                         val s = String.concat (rev ss)
                     in
-                        ((ENextval {seq = seq, prepared = SOME (#2 sns, s)}, loc),
+                        ((ENextval {seq = seq, prepared = SOME {id = #2 sns, query = s}}, loc),
                          ((s, n) :: #1 sns, #2 sns + 1))
                     end
             end
diff --git a/src/settings.sig b/src/settings.sig
index c7855856..c1a6d871 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -137,7 +137,8 @@ signature SETTINGS = sig
          queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
                           inputs : sql_type list, cols : sql_type list,
                           doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-                                   -> Print.PD.pp_desc}
+                                   -> Print.PD.pp_desc,
+                          nested : bool}
                          -> Print.PD.pp_desc,
          dml : ErrorMsg.span -> Print.PD.pp_desc,
          dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
@@ -150,7 +151,8 @@ signature SETTINGS = sig
          supportsDeleteAs : bool,
          createSequence : string -> string,
          textKeysNeedLengths : bool,
-         supportsNextval : bool
+         supportsNextval : bool,
+         supportsNestedPrepared : bool
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 7393013e..812e323f 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -327,7 +327,8 @@ type dbms = {
      queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
                       inputs : sql_type list, cols : sql_type list,
                       doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-                               -> Print.PD.pp_desc}
+                               -> Print.PD.pp_desc,
+                      nested : bool}
                      -> Print.PD.pp_desc,
      dml : ErrorMsg.span -> Print.PD.pp_desc,
      dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
@@ -340,7 +341,8 @@ type dbms = {
      supportsDeleteAs : bool,
      createSequence : string -> string,
      textKeysNeedLengths : bool,
-     supportsNextval : bool
+     supportsNextval : bool,
+     supportsNestedPrepared : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -361,7 +363,8 @@ val curDb = ref ({name = "",
                   supportsDeleteAs = false,
                   createSequence = fn _ => "",
                   textKeysNeedLengths = false,
-                  supportsNextval = false} : dbms)
+                  supportsNextval = false,
+                  supportsNestedPrepared = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff --git a/src/sources b/src/sources
index b284e5a9..ea6ae586 100644
--- a/src/sources
+++ b/src/sources
@@ -192,6 +192,9 @@ scriptcheck.sml
 prepare.sig
 prepare.sml
 
+checknest.sig
+checknest.sml
+
 compiler.sig
 compiler.sml