diff src/cjr_print.sml @ 866:03e7f111fe99

Start of multi-DBMS support
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 13:49:32 -0400
parents 305bc0a431de
children e7f80d78075b
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Jun 28 11:49:04 2009 -0400
+++ b/src/cjr_print.sml	Sun Jun 28 13:49:32 2009 -0400
@@ -2039,6 +2039,8 @@
              string "}"]
     end
 
+val prepped = ref ([] : (string * int) list)
+
 fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DStruct (n, xts) =>
@@ -2196,115 +2198,8 @@
              string "static void uw_db_prepare(uw_context);",
              newline,
              newline,
-             string "void uw_db_init(uw_context ctx) {",
-             newline,
-             string "PGconn *conn = PQconnectdb(\"",
-             string (String.toString name),
-             string "\");",
-             newline,
-             string "if (conn == NULL) uw_error(ctx, BOUNDED_RETRY, ",
-             string "\"libpq can't allocate a connection.\");",
-             newline,
-             string "if (PQstatus(conn) != CONNECTION_OK) {",
-             newline,
-             box [string "char msg[1024];",
-                  newline,
-                  string "strncpy(msg, PQerrorMessage(conn), 1024);",
-                  newline,
-                  string "msg[1023] = 0;",
-                  newline,
-                  string "PQfinish(conn);",
-                  newline,
-                  string "uw_error(ctx, BOUNDED_RETRY, ",
-                  string "\"Connection to Postgres server failed: %s\", msg);"],
-             newline,
-             string "}",
-             newline,
-             string "uw_set_db(ctx, conn);",
-             newline,
-             string "uw_db_validate(ctx);",
-             newline,
-             string "uw_db_prepare(ctx);",
-             newline,
-             string "}",
-             newline,
-             newline,
-             string "void uw_db_close(uw_context ctx) {",
-             newline,
-             string "PQfinish(uw_get_db(ctx));",
-             newline,
-             string "}",
-             newline,
-             newline,
 
-             string "int uw_db_begin(uw_context ctx) {",
-             newline,
-             string "PGconn *conn = uw_get_db(ctx);",
-             newline,
-             string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
-             newline,
-             newline,
-             string "if (res == NULL) return 1;",
-             newline,
-             newline,
-             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-             box [string "PQclear(res);",
-                  newline,
-                  string "return 1;",
-                  newline],
-             string "}",
-             newline,
-             string "return 0;",
-             newline,
-             string "}",
-             newline,
-             newline,
-
-             string "int uw_db_commit(uw_context ctx) {",
-             newline,
-             string "PGconn *conn = uw_get_db(ctx);",
-             newline,
-             string "PGresult *res = PQexec(conn, \"COMMIT\");",
-             newline,
-             newline,
-             string "if (res == NULL) return 1;",
-             newline,
-             newline,
-             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-             box [string "PQclear(res);",
-                  newline,
-                  string "return 1;",
-                  newline],
-             string "}",
-             newline,
-             string "return 0;",
-             newline,
-             string "}",
-             newline,
-             newline,
-
-             string "int uw_db_rollback(uw_context ctx) {",
-             newline,
-             string "PGconn *conn = uw_get_db(ctx);",
-             newline,
-             string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
-             newline,
-             newline,
-             string "if (res == NULL) return 1;",
-             newline,
-             newline,
-             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-             box [string "PQclear(res);",
-                  newline,
-                  string "return 1;",
-                  newline],
-             string "}",
-             newline,
-             string "return 0;",
-             newline,
-             string "}",
-             newline,
-             newline,
+             #init (Settings.currentDbms ()) (name, !prepped),
 
              string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
              newline,
@@ -2323,54 +2218,9 @@
              string "}",
              newline]
 
-      | DPreparedStatements [] =>
-        box [string "static void uw_db_prepare(uw_context ctx) {",
-             newline,
-             string "}"]
       | DPreparedStatements ss =>
-        if #persistent (Settings.currentProtocol ()) then
-            box [string "static void uw_db_prepare(uw_context ctx) {",
-                 newline,
-                 string "PGconn *conn = uw_get_db(ctx);",
-                 newline,
-                 string "PGresult *res;",
-                 newline,
-                 newline,
-
-                 p_list_sepi newline (fn i => fn (s, n) =>
-                                                 box [string "res = PQprepare(conn, \"uw",
-                                                      string (Int.toString i),
-                                                      string "\", \"",
-                                                      string (String.toString s),
-                                                      string "\", ",
-                                                      string (Int.toString n),
-                                                      string ", NULL);",
-                                                      newline,
-                                                      string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-                                                      newline,
-                                                      box [string "char msg[1024];",
-                                                           newline,
-                                                           string "strncpy(msg, PQerrorMessage(conn), 1024);",
-                                                           newline,
-                                                           string "msg[1023] = 0;",
-                                                           newline,
-                                                           string "PQclear(res);",
-                                                           newline,
-                                                           string "PQfinish(conn);",
-                                                           newline,
-                                                           string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
-                                                           string (String.toString s),
-                                                           string "\\n%s\", msg);",
-                                                           newline],
-                                                      string "}",
-                                                      newline,
-                                                      string "PQclear(res);",
-                                                      newline])
-                             ss,
-                 
-                 string "}"]
-        else
-            string "static void uw_db_prepare(uw_context ctx) { }"
+        (prepped := ss;
+         box [])
 
       | DJavaScript s => box [string "static char jslib[] = \"",
                               string (String.toString s),
@@ -3268,7 +3118,7 @@
              string "#include <math.h>",
              newline,
              if hasDb then
-                 box [string "#include <postgresql/libpq-fe.h>",
+                 box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"),
                       newline]
              else
                  box [],