summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-06-28 13:49:32 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-06-28 13:49:32 -0400
commit5c154f05f5e4735d999927925a771b3a21f5a22d (patch)
treea31efa1a10c57b3b2db7f7ba7008b4871a70e2a6 /src/cjr_print.sml
parent5952e97040dd9331865368bb726b8059dbedbc5a (diff)
Start of multi-DBMS support
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml162
1 files changed, 6 insertions, 156 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 14721edd..d3f1b469 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2039,6 +2039,8 @@ fun p_fun env (fx, n, args, ran, e) =
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 @@ fun p_decl env (dAll as (d, _) : decl) =
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 @@ fun p_decl env (dAll as (d, _) : decl) =
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 @@ fun p_file env (ds, ps) =
string "#include <math.h>",
newline,
if hasDb then
- box [string "#include <postgresql/libpq-fe.h>",
+ box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"),
newline]
else
box [],