summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-06-28 16:22:17 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-06-28 16:22:17 -0400
commit566f9f69e1abbed1891e5eec4a94325c79572f16 (patch)
treea60c8ed4fb8703fb61d9844d7b02129464c2c6be /src/cjr_print.sml
parent5a877e7f69430dbb6c5b1398b15a7b64916c39a8 (diff)
Moved dml code into Settings
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml85
1 files changed, 10 insertions, 75 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 92e15b51..ee9011b7 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1696,16 +1696,16 @@ fun p_exp' par env (e, loc) =
| EDml {dml, prepared} =>
box [string "(uw_begin_region(ctx), ({",
newline,
- string "PGconn *conn = uw_get_db(ctx);",
- newline,
case prepared of
NONE => box [string "char *dml = ",
p_exp env dml,
string ";",
- newline]
- | SOME _ =>
+ newline,
+ newline,
+ #dml (Settings.currentDbms ()) loc]
+ | SOME (id, dml') =>
let
- val ets = getPargs dml
+ val inputs = getPargs dml
in
box [p_list_sepi newline
(fn i => fn (e, t) =>
@@ -1718,83 +1718,18 @@ fun p_exp' par env (e, loc) =
space,
p_exp env e,
string ";"])
- ets,
+ inputs,
newline,
newline,
- string "const int paramFormats[] = { ",
- p_list_sep (box [string ",", space])
- (fn (_, t) => if isBlob t then string "1" else string "0") ets,
- string " };",
- newline,
- string "const int paramLengths[] = { ",
- p_list_sepi (box [string ",", space])
- (fn i => fn (_, Blob) => string ("arg" ^ Int.toString (i + 1) ^ ".size")
- | (_, Nullable Blob) => string ("arg" ^ Int.toString (i + 1)
- ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
- | _ => string "0") ets,
- string " };",
- newline,
- string "const char *paramValues[] = { ",
- p_list_sepi (box [string ",", space])
- (fn i => fn (_, t) => p_ensql t (box [string "arg",
- string (Int.toString (i + 1))]))
- ets,
- string " };",
- newline,
- newline]
+ #dmlPrepared (Settings.currentDbms ()) {loc = loc,
+ id = id,
+ dml = dml',
+ inputs = map #2 inputs}]
end,
newline,
newline,
- string "PGresult *res = ",
- case prepared of
- NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);"
- | SOME (n, s) =>
- if #persistent (Settings.currentProtocol ()) then
- box [string "PQexecPrepared(conn, \"uw",
- string (Int.toString n),
- string "\", ",
- string (Int.toString (length (getPargs dml))),
- string ", paramValues, paramLengths, paramFormats, 0);"]
- else
- box [string "PQexecParams(conn, \"",
- string (String.toString s),
- string "\", ",
- string (Int.toString (length (getPargs dml))),
- string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
- newline,
- newline,
-
- string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
- newline,
- newline,
- string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
- newline,
- box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
- box [newline,
- string "PQclear(res);",
- newline,
- string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
- newline],
- string "}",
- newline,
- string "PQclear(res);",
- newline,
- string "uw_error(ctx, FATAL, \"",
- string (ErrorMsg.spanToString loc),
- string ": DML failed:\\n%s\\n%s\", ",
- case prepared of
- NONE => string "dml"
- | SOME _ => p_exp env dml,
- string ", PQerrorMessage(conn));",
- newline],
- string "}",
- newline,
- newline,
-
- string "PQclear(res);",
- newline,
string "uw_end_region(ctx);",
newline,
string "uw_unit_v;",