summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml630
1 files changed, 329 insertions, 301 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 683c2ddf..b8db23e8 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1641,11 +1641,19 @@ fun p_exp' par env (e, loc) =
string "PGresult *res = ",
case prepared of
NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
- | SOME n => box [string "PQexecPrepared(conn, \"uw",
- string (Int.toString n),
- string "\", ",
- string (Int.toString (length (getPargs query))),
- string ", paramValues, paramLengths, paramFormats, 0);"],
+ | SOME (n, s) =>
+ if #persistent (Settings.currentProtocol ()) then
+ box [string "PQexecPrepared(conn, \"uw",
+ string (Int.toString n),
+ string "\", ",
+ string (Int.toString (length (getPargs query))),
+ string ", paramValues, paramLengths, paramFormats, 0);"]
+ else
+ box [string "PQexecParams(conn, \"",
+ string (String.toString s),
+ string "\", ",
+ string (Int.toString (length (getPargs query))),
+ string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
newline,
newline,
@@ -1820,11 +1828,19 @@ fun p_exp' par env (e, loc) =
string "PGresult *res = ",
case prepared of
NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);"
- | SOME n => box [string "PQexecPrepared(conn, \"uw",
- string (Int.toString n),
- string "\", ",
- string (Int.toString (length (getPargs dml))),
- string ", paramValues, paramLengths, paramFormats, 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,
@@ -1892,9 +1908,15 @@ fun p_exp' par env (e, loc) =
string "PGresult *res = ",
case prepared of
NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
- | SOME n => box [string "PQexecPrepared(conn, \"uw",
- string (Int.toString n),
- string "\", 0, 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,
@@ -2306,46 +2328,49 @@ fun p_decl env (dAll as (d, _) : decl) =
newline,
string "}"]
| DPreparedStatements ss =>
- box [string "static void uw_db_prepare(uw_context ctx) {",
- newline,
- string "PGconn *conn = uw_get_db(ctx);",
- newline,
- string "PGresult *res;",
- newline,
- newline,
+ 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 "}"]
+ 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) { }"
| DJavaScript s => box [string "static char jslib[] = \"",
string (String.toString s),
@@ -2928,256 +2953,259 @@ fun p_file env (ds, ps) =
| _ => NONE) ds
val validate =
- box [string "static void uw_db_validate(uw_context ctx) {",
- newline,
- string "PGconn *conn = uw_get_db(ctx);",
- newline,
- string "PGresult *res;",
- newline,
- newline,
- p_list_sep newline
- (fn (s, xts) =>
- let
- val sl = CharVector.map Char.toLower s
-
- val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
- ^ sl ^ "'"
-
- val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
- sl,
- "') AND (",
- String.concatWith " OR "
- (map (fn (x, t) =>
- String.concat ["(attname = 'uw_",
- CharVector.map
- Char.toLower (ident x),
- "' AND atttypid = (SELECT oid FROM pg_type",
- " WHERE typname = '",
- p_sqltype_base' env t,
- "') AND attnotnull = ",
- if is_not_null t then
- "TRUE"
- else
- "FALSE",
- ")"]) xts),
- ")"]
-
- val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
- sl,
- "') AND attname LIKE 'uw_%'"]
- in
- box [string "res = PQexec(conn, \"",
- string q,
- string "\");",
- newline,
- newline,
- string "if (res == NULL) {",
- newline,
- box [string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
- newline],
- string "}",
- newline,
- newline,
- string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
- string q,
- string "\\n%s\", msg);",
- newline],
- string "}",
- newline,
- newline,
- string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
- newline,
- box [string "PQclear(res);",
- newline,
- string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Table '",
- string s,
- string "' does not exist.\");",
- newline],
- string "}",
- newline,
- newline,
- string "PQclear(res);",
- newline,
-
- string "res = PQexec(conn, \"",
- string q',
- string "\");",
- newline,
- newline,
- string "if (res == NULL) {",
- newline,
- box [string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
- newline],
- string "}",
- newline,
- newline,
- string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
- string q',
- string "\\n%s\", msg);",
- newline],
- string "}",
- newline,
- newline,
- string "if (strcmp(PQgetvalue(res, 0, 0), \"",
- string (Int.toString (length xts)),
- string "\")) {",
- newline,
- box [string "PQclear(res);",
- newline,
- string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Table '",
- string s,
- string "' has the wrong column types.\");",
- newline],
- string "}",
- newline,
- newline,
- string "PQclear(res);",
- newline,
- newline,
-
- string "res = PQexec(conn, \"",
- string q'',
- string "\");",
- newline,
- newline,
- string "if (res == NULL) {",
- newline,
- box [string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
- newline],
- string "}",
- newline,
- newline,
- string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
- string q'',
- string "\\n%s\", msg);",
- newline],
- string "}",
- newline,
- newline,
- string "if (strcmp(PQgetvalue(res, 0, 0), \"",
- string (Int.toString (length xts)),
- string "\")) {",
- newline,
- box [string "PQclear(res);",
- newline,
- string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Table '",
- string s,
- string "' has extra columns.\");",
- newline],
- string "}",
- newline,
- newline,
- string "PQclear(res);",
- newline]
- end) tables,
-
- p_list_sep newline
- (fn s =>
- let
- val sl = CharVector.map Char.toLower s
-
- val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
- ^ sl ^ "' AND relkind = 'S'"
- in
- box [string "res = PQexec(conn, \"",
- string q,
- string "\");",
- newline,
- newline,
- string "if (res == NULL) {",
- newline,
- box [string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
- newline],
- string "}",
- newline,
- newline,
- string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
- string q,
- string "\\n%s\", msg);",
- newline],
- string "}",
- newline,
- newline,
- string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
- newline,
- box [string "PQclear(res);",
- newline,
- string "PQfinish(conn);",
- newline,
- string "uw_error(ctx, FATAL, \"Sequence '",
- string s,
- string "' does not exist.\");",
- newline],
- string "}",
- newline,
- newline,
- string "PQclear(res);",
- newline]
- end) sequences,
+ if #persistent (Settings.currentProtocol ()) then
+ box [string "static void uw_db_validate(uw_context ctx) {",
+ newline,
+ string "PGconn *conn = uw_get_db(ctx);",
+ newline,
+ string "PGresult *res;",
+ newline,
+ newline,
+ p_list_sep newline
+ (fn (s, xts) =>
+ let
+ val sl = CharVector.map Char.toLower s
+
+ val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
+ ^ sl ^ "'"
+
+ val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
+ sl,
+ "') AND (",
+ String.concatWith " OR "
+ (map (fn (x, t) =>
+ String.concat ["(attname = 'uw_",
+ CharVector.map
+ Char.toLower (ident x),
+ "' AND atttypid = (SELECT oid FROM pg_type",
+ " WHERE typname = '",
+ p_sqltype_base' env t,
+ "') AND attnotnull = ",
+ if is_not_null t then
+ "TRUE"
+ else
+ "FALSE",
+ ")"]) xts),
+ ")"]
+
+ val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
+ sl,
+ "') AND attname LIKE 'uw_%'"]
+ in
+ box [string "res = PQexec(conn, \"",
+ string q,
+ string "\");",
+ newline,
+ newline,
+ string "if (res == NULL) {",
+ newline,
+ box [string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
+ string q,
+ string "\\n%s\", msg);",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Table '",
+ string s,
+ string "' does not exist.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "PQclear(res);",
+ newline,
- string "}"]
+ string "res = PQexec(conn, \"",
+ string q',
+ string "\");",
+ newline,
+ newline,
+ string "if (res == NULL) {",
+ newline,
+ box [string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
+ string q',
+ string "\\n%s\", msg);",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (strcmp(PQgetvalue(res, 0, 0), \"",
+ string (Int.toString (length xts)),
+ string "\")) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Table '",
+ string s,
+ string "' has the wrong column types.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "PQclear(res);",
+ newline,
+ newline,
+
+ string "res = PQexec(conn, \"",
+ string q'',
+ string "\");",
+ newline,
+ newline,
+ string "if (res == NULL) {",
+ newline,
+ box [string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
+ string q'',
+ string "\\n%s\", msg);",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (strcmp(PQgetvalue(res, 0, 0), \"",
+ string (Int.toString (length xts)),
+ string "\")) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Table '",
+ string s,
+ string "' has extra columns.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "PQclear(res);",
+ newline]
+ end) tables,
+
+ p_list_sep newline
+ (fn s =>
+ let
+ val sl = CharVector.map Char.toLower s
+
+ val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
+ ^ sl ^ "' AND relkind = 'S'"
+ in
+ box [string "res = PQexec(conn, \"",
+ string q,
+ string "\");",
+ newline,
+ newline,
+ string "if (res == NULL) {",
+ newline,
+ box [string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (PQresultStatus(res) != PGRES_TUPLES_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, \"Query failed:\\n",
+ string q,
+ string "\\n%s\", msg);",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "PQfinish(conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Sequence '",
+ string s,
+ string "' does not exist.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "PQclear(res);",
+ newline]
+ end) sequences,
+
+ string "}"]
+ else
+ string "static void uw_db_validate(uw_context ctx) { }"
val hasDb = List.exists (fn (DDatabase _, _) => true | _ => false) ds
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 21:44:02 +0000