Moved nextval code into Settings

5 files changed, 94 insertions, 71 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index ee9011b7..a5a67401 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1751,81 +1751,23 @@ fun p_exp' par env (e, loc) =
             box [string "(uw_begin_region(ctx), ",
                  string "({",
                  newline,
-                 string "PGconn *conn = uw_get_db(ctx);",
+                 string "uw_Basis_int n;",
                  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, s) =>
-                     if #persistent (Settings.currentProtocol ()) then
-                         box [string "PQexecPrepared(conn, \"uw",
-                              string (Int.toString n),
-                              string "\", 0, NULL, NULL, NULL, 0);"]
-                     else
-                         box [string "PQexecParams(conn, \"uw",
-                              string (Int.toString n),
-                              string "\", 0, NULL, 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,
+                                  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 "}",
+                                  #nextval (Settings.currentDbms ()) loc]
+                   | SOME (id, query) => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
+                                                                                     id = id,
+                                                                                     query = query},
                  newline,
                  newline,
 
-                 string "n = ",
-                 p_unsql true env (TFfi ("Basis", "int"), loc)
-                         (string "PQgetvalue(res, 0, 0)")
-                         (box []),
-                 string ";",
-                 newline,
-                 string "PQclear(res);",
-                 newline,
                  string "n;",
                  newline,
                  string "}))"]
diff --git a/src/mysql.sml b/src/mysql.sml
index 27b4ca77..6f3d99cd 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -257,6 +257,8 @@ fun query _ = raise Fail "MySQL query"
 fun queryPrepared _ = raise Fail "MySQL queryPrepared"
 fun dml _ = raise Fail "MySQL dml"
 fun dmlPrepared _ = raise Fail "MySQL dmlPrepared"
+fun nextval _ = raise Fail "MySQL nextval"
+fun nextvalPrepared _ = raise Fail "MySQL nextvalPrepared"
 
 val () = addDbms {name = "mysql",
                   header = "mysql/mysql.h",
@@ -277,6 +279,8 @@ val () = addDbms {name = "mysql",
                   query = query,
                   queryPrepared = queryPrepared,
                   dml = dml,
-                  dmlPrepared = dmlPrepared}
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index 01777843..b1390bc4 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -472,6 +472,75 @@ fun dmlPrepared {loc, id, dml, inputs} =
                                           string (String.toString dml),
                                           string "\""]}]
 
+fun nextvalCommon {loc, query} =
+    box [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\", ",
+              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\", ",
+              query,
+              string ", PQerrorMessage(conn));",
+              newline],
+         string "}",
+         newline,
+         newline,
+
+         string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
+         newline,
+         string "PQclear(res);",
+         newline]
+
+fun nextval loc =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
+         newline,
+         newline,
+         nextvalCommon {loc = loc, query = string "query"}]
+
+fun nextvalPrepared {loc, id, query} =
+    box [string "PGconn *conn = uw_get_db(ctx);",
+         newline,
+         newline,
+         string "PGresult *res = ",
+         if #persistent (Settings.currentProtocol ()) then
+             box [string "PQexecPrepared(conn, \"uw",
+                  string (Int.toString id),
+                  string "\", 0, NULL, NULL, NULL, 0);"]
+         else
+             box [string "PQexecParams(conn, \"",
+                  string (String.toString query),
+                  string "\", 0, NULL, NULL, NULL, NULL, 0);"],
+         newline,
+         newline,
+         nextvalCommon {loc = loc, query = box [string "\"",
+                                                string (String.toString query),
+                                                string "\""]}]
+
 val () = addDbms {name = "postgres",
                   header = "postgresql/libpq-fe.h",
                   link = "-lpq",
@@ -481,7 +550,9 @@ val () = addDbms {name = "postgres",
                   query = query,
                   queryPrepared = queryPrepared,
                   dml = dml,
-                  dmlPrepared = dmlPrepared}
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared}
 val () = setDbms "postgres"
 
 end
diff --git a/src/settings.sig b/src/settings.sig
index 9912b0e1..3b897353 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -138,7 +138,9 @@ signature SETTINGS = sig
                          -> Print.PD.pp_desc,
          dml : ErrorMsg.span -> Print.PD.pp_desc,
          dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
-                        inputs : sql_type list} -> Print.PD.pp_desc
+                        inputs : sql_type list} -> Print.PD.pp_desc,
+         nextval : ErrorMsg.span -> Print.PD.pp_desc,
+         nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 86d8afa9..8ad1d3f6 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -324,7 +324,9 @@ type dbms = {
                      -> Print.PD.pp_desc,
      dml : ErrorMsg.span -> Print.PD.pp_desc,
      dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
-                    inputs : sql_type list} -> Print.PD.pp_desc
+                    inputs : sql_type list} -> Print.PD.pp_desc,
+     nextval : ErrorMsg.span -> Print.PD.pp_desc,
+     nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc
 }
 
 val dbmses = ref ([] : dbms list)
@@ -336,7 +338,9 @@ val curDb = ref ({name = "",
                   query = fn _ => Print.box [],
                   queryPrepared = fn _ => Print.box [],
                   dml = fn _ => Print.box [],
-                  dmlPrepared = fn _ => Print.box []} : dbms)
+                  dmlPrepared = fn _ => Print.box [],
+                  nextval = fn _ => Print.box [],
+                  nextvalPrepared = fn _ => Print.box []} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =