changeset 869:64ba57fa20bf

Moved nextval code into Settings
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 16:41:10 -0400
parents 06497beb265b
children 7fa9a37a34b3
files src/cjr_print.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml
diffstat 5 files changed, 95 insertions(+), 72 deletions(-) [+]
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Jun 28 16:22:17 2009 -0400
+++ b/src/cjr_print.sml	Sun Jun 28 16:41:10 2009 -0400
@@ -1751,81 +1751,23 @@
             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,
+
+                                  #nextval (Settings.currentDbms ()) loc]
+                   | SOME (id, query) => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
+                                                                                     id = id,
+                                                                                     query = query},
                  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)")
-                         (box []),
-                 string ";",
-                 newline,
-                 string "PQclear(res);",
-                 newline,
                  string "n;",
                  newline,
                  string "}))"]
--- a/src/mysql.sml	Sun Jun 28 16:22:17 2009 -0400
+++ b/src/mysql.sml	Sun Jun 28 16:41:10 2009 -0400
@@ -257,6 +257,8 @@
 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 @@
                   query = query,
                   queryPrepared = queryPrepared,
                   dml = dml,
-                  dmlPrepared = dmlPrepared}
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared}
 
 end
--- a/src/postgres.sml	Sun Jun 28 16:22:17 2009 -0400
+++ b/src/postgres.sml	Sun Jun 28 16:41:10 2009 -0400
@@ -472,6 +472,75 @@
                                           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 @@
                   query = query,
                   queryPrepared = queryPrepared,
                   dml = dml,
-                  dmlPrepared = dmlPrepared}
+                  dmlPrepared = dmlPrepared,
+                  nextval = nextval,
+                  nextvalPrepared = nextvalPrepared}
 val () = setDbms "postgres"
 
 end
--- a/src/settings.sig	Sun Jun 28 16:22:17 2009 -0400
+++ b/src/settings.sig	Sun Jun 28 16:41:10 2009 -0400
@@ -138,7 +138,9 @@
                          -> 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
--- a/src/settings.sml	Sun Jun 28 16:22:17 2009 -0400
+++ b/src/settings.sml	Sun Jun 28 16:41:10 2009 -0400
@@ -324,7 +324,9 @@
                      -> 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 @@
                   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 =