summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-14 11:02:18 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-14 11:02:18 -0400
commitc81c24b4feb3fae3c13861f1bcaafab697a6bb7e (patch)
tree4f168489261d0202a9d664e548dd71a10665df46 /src/cjr_print.sml
parent0faed8b64498534297bd797108b659802815aefc (diff)
SQL sequences
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml91
1 files changed, 91 insertions, 0 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index f784f3d4..fdd02a3b 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -976,6 +976,87 @@ fun p_exp' par env (e, loc) =
newline,
string "}))"]
+ | ENextval {seq, prepared} =>
+ let
+ val query = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
+ val query = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), query]), loc)
+ in
+ box [string "(uw_begin_region(ctx), ",
+ string "({",
+ newline,
+ string "PGconn *conn = uw_get_db(ctx);",
+ 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 => box [string "PQexecPrepared(conn, \"uw",
+ string (Int.toString n),
+ string "\", 0, NULL, NULL, NULL, 0);"],
+ newline,
+ string "uw_Basis_int n;",
+ 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)"),
+ string ";",
+ newline,
+ string "PQclear(res);",
+ newline,
+ string "n;",
+ newline,
+ string "}))"]
+ end
+
and p_exp env = p_exp' false env
fun p_fun env (fx, n, args, ran, e) =
@@ -1119,6 +1200,10 @@ fun p_decl env (dAll as (d, _) : decl) =
string x,
string " */",
newline]
+ | DSequence x => box [string "/* SQL sequence ",
+ string x,
+ string " */",
+ newline]
| DDatabase s => box [string "static void uw_db_validate(uw_context);",
newline,
string "static void uw_db_prepare(uw_context);",
@@ -1938,6 +2023,12 @@ fun p_sql env (ds, _) =
string ");",
newline,
newline]
+ | DSequence s =>
+ box [string "CREATE SEQUENCE ",
+ string s,
+ string ";",
+ newline,
+ newline]
| _ => box []
in
(pp, E.declBinds env dAll)