summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/cjr_print.sml360
-rw-r--r--src/mysql.sml2
-rw-r--r--src/postgres.sml281
-rw-r--r--src/settings.sig11
-rw-r--r--src/settings.sml28
5 files changed, 354 insertions, 328 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index a5a67401..7e2cbc52 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1837,8 +1837,6 @@ 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) =>
@@ -1990,35 +1988,8 @@ fun p_decl env (dAll as (d, _) : decl) =
space,
string " */",
newline]
- | DDatabase {name, expunge, initialize} =>
- box [string "static void uw_db_validate(uw_context);",
- newline,
- string "static void uw_db_prepare(uw_context);",
- newline,
- newline,
-
- #init (Settings.currentDbms ()) (name, !prepped),
-
- string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
- newline,
- box [p_enamed env expunge,
- string "(ctx, cli);",
- newline],
- string "}",
- newline,
- newline,
-
- string "void uw_initializer(uw_context ctx) {",
- newline,
- box [p_enamed env initialize,
- string "(ctx, uw_unit_v);",
- newline],
- string "}",
- newline]
-
- | DPreparedStatements ss =>
- (prepped := ss;
- box [])
+ | DDatabase _ => box []
+ | DPreparedStatements _ => box []
| DJavaScript s => box [string "static char jslib[] = \"",
string (String.toString s),
@@ -2605,267 +2576,27 @@ fun p_file env (ds, ps) =
val pds' = map p_page ps
- val tables = List.mapPartial (fn (DTable (s, xts, _, _), _) => SOME (s, xts)
- | _ => NONE) ds
- val sequences = List.mapPartial (fn (DSequence s, _) => SOME s
- | _ => NONE) ds
-
- val validate =
- 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 "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
+ val hasDb = ref false
+ val tables = ref []
+ val sequences = ref []
+ val dbstring = ref ""
+ val expunge = ref 0
+ val initialize = ref 0
+ val prepped = ref []
+
+ val () = app (fn d =>
+ case #1 d of
+ DDatabase {name = x, expunge = y, initialize = z} => (hasDb := true;
+ dbstring := x;
+ expunge := y;
+ initialize := z)
+ | DTable (s, xts, _, _) => tables := (s, map (fn (x, t) =>
+ (x, sql_type_in env t)) xts) :: !tables
+ | DSequence s => sequences := s :: !sequences
+ | DPreparedStatements ss => prepped := ss
+ | _ => ()) ds
+
+ val hasDb = !hasDb
val cookies = List.mapPartial (fn (DCookie s, _) => SOME s | _ => NONE) ds
@@ -2920,7 +2651,6 @@ fun p_file env (ds, ps) =
newline]
else
box [],
- newline,
p_list_sep (box []) (fn s => box [string "#include \"",
string s,
string "\"",
@@ -2932,6 +2662,22 @@ fun p_file env (ds, ps) =
newline,
newline,
+ if hasDb then
+ #init (Settings.currentDbms ()) {dbstring = !dbstring,
+ prepared = !prepped,
+ tables = !tables,
+ sequences = !sequences}
+ else
+ box [string "void uw_db_init(uw_context ctx) { };",
+ newline,
+ string "int uw_db_begin(uw_context ctx) { return 0; };",
+ newline,
+ string "int uw_db_commit(uw_context ctx) { return 0; };",
+ newline,
+ string "int uw_db_rollback(uw_context ctx) { return 0; };"],
+ newline,
+ newline,
+
string "const char *uw_url_prefix = \"",
string (Settings.getUrlPrefix ()),
string "\";",
@@ -3008,24 +2754,26 @@ fun p_file env (ds, ps) =
string "}",
newline,
newline,
+
if hasDb then
- validate
- else
- box [],
- newline,
- if List.exists (fn (DDatabase _, _) => true | _ => false) ds then
- box []
- else
- box [newline,
- string "void uw_db_init(uw_context ctx) { };",
+ box [string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
newline,
- string "int uw_db_begin(uw_context ctx) { return 0; };",
+ box [p_enamed env (!expunge),
+ string "(ctx, cli);",
+ newline],
+ string "}",
newline,
- string "int uw_db_commit(uw_context ctx) { return 0; };",
newline,
- string "int uw_db_rollback(uw_context ctx) { return 0; };",
+
+ string "void uw_initializer(uw_context ctx) {",
newline,
- string "void uw_expunger(uw_context ctx, uw_Basis_client cli) { };",
+ box [p_enamed env (!initialize),
+ string "(ctx, uw_unit_v);",
+ newline],
+ string "}",
+ newline]
+ else
+ box [string "void uw_expunger(uw_context ctx, uw_Basis_client cli) { };",
newline,
string "void uw_initializer(uw_context ctx) { };",
newline]]
diff --git a/src/mysql.sml b/src/mysql.sml
index 6f3d99cd..897b4a58 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -31,7 +31,7 @@ open Settings
open Print.PD
open Print
-fun init (dbstring, ss) =
+fun init {dbstring, prepared = ss, tables, sequences} =
let
val host = ref NONE
val user = ref NONE
diff --git a/src/postgres.sml b/src/postgres.sml
index b1390bc4..1fdda8ff 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -31,9 +31,275 @@ open Settings
open Print.PD
open Print
-fun init (dbstring, ss) =
+val ident = String.translate (fn #"'" => "PRIME"
+ | ch => str ch)
+
+fun p_sql_type_base t =
+ case t of
+ Int => "int8"
+ | Float => "float8"
+ | String => "text"
+ | Bool => "bool"
+ | Time => "timestamp"
+ | Blob => "bytea"
+ | Channel => "int8"
+ | Client => "int4"
+ | Nullable t => p_sql_type_base t
+
+fun init {dbstring, prepared = ss, tables, sequences} =
box [if #persistent (currentProtocol ()) then
- box [string "static void uw_db_prepare(uw_context ctx) {",
+ 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_sql_type_base t,
+ "') AND attnotnull = ",
+ if isNotNull 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,
+
+ string "}",
+
+ string "static void uw_db_prepare(uw_context ctx) {",
newline,
string "PGconn *conn = uw_get_db(ctx);",
newline,
@@ -153,7 +419,10 @@ fun init (dbstring, ss) =
newline,
newline]
else
- string "static void uw_db_prepare(uw_context ctx) { }",
+ box [string "static void uw_db_validate(uw_context ctx) { }",
+ newline,
+ string "static void uw_db_prepare(uw_context ctx) { }"],
+
newline,
newline,
@@ -222,10 +491,10 @@ fun p_getcol {wontLeakStrings, col = i, typ = t} =
String => getter t
| _ => box [string "({",
newline,
- p_sql_type t,
+ string (p_sql_type t),
space,
string "*tmp = uw_malloc(ctx, sizeof(",
- p_sql_type t,
+ string (p_sql_type t),
string "));",
newline,
string "*tmp = ",
@@ -241,7 +510,7 @@ fun p_getcol {wontLeakStrings, col = i, typ = t} =
string (Int.toString i),
string ") ? ",
box [string "({",
- p_sql_type t,
+ string (p_sql_type t),
space,
string "tmp;",
newline,
diff --git a/src/settings.sig b/src/settings.sig
index 3b897353..0ed2924b 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -112,8 +112,9 @@ signature SETTINGS = sig
| Client
| Nullable of sql_type
- val p_sql_type : sql_type -> Print.PD.pp_desc
+ val p_sql_type : sql_type -> string
val isBlob : sql_type -> bool
+ val isNotNull : sql_type -> bool
type dbms = {
name : string,
@@ -124,9 +125,11 @@ signature SETTINGS = sig
(* Pass these linker arguments *)
global_init : Print.PD.pp_desc,
(* Define uw_client_init() *)
- init : string * (string * int) list -> Print.PD.pp_desc,
- (* Define uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback()
- * from dbstring and prepared statements *)
+ init : {dbstring : string,
+ prepared : (string * int) list,
+ tables : (string * (string * sql_type) list) list,
+ sequences : string list} -> Print.PD.pp_desc,
+ (* Define uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *)
query : {loc : ErrorMsg.span, numCols : int,
doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc}
diff --git a/src/settings.sml b/src/settings.sml
index 8ad1d3f6..dbc3bf77 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -291,28 +291,34 @@ fun p_sql_type t =
open Print
in
case t of
- Int => string "uw_Basis_int"
- | Float => string "uw_Basis_float"
- | String => string "uw_Basis_string"
- | Bool => string "uw_Basis_bool"
- | Time => string "uw_Basis_time"
- | Blob => string "uw_Basis_blob"
- | Channel => string "uw_Basis_channel"
- | Client => string "uw_Basis_client"
- | Nullable String => string "uw_Basis_string"
- | Nullable t => box [p_sql_type t, string "*"]
+ Int => "uw_Basis_int"
+ | Float => "uw_Basis_float"
+ | String => "uw_Basis_string"
+ | Bool => "uw_Basis_bool"
+ | Time => "uw_Basis_time"
+ | Blob => "uw_Basis_blob"
+ | Channel => "uw_Basis_channel"
+ | Client => "uw_Basis_client"
+ | Nullable String => "uw_Basis_string"
+ | Nullable t => p_sql_type t ^ "*"
end
fun isBlob Blob = true
| isBlob (Nullable t) = isBlob t
| isBlob _ = false
+fun isNotNull (Nullable _) = false
+ | isNotNull _ = true
+
type dbms = {
name : string,
header : string,
link : string,
global_init : Print.PD.pp_desc,
- init : string * (string * int) list -> Print.PD.pp_desc,
+ init : {dbstring : string,
+ prepared : (string * int) list,
+ tables : (string * (string * sql_type) list) list,
+ sequences : string list} -> Print.PD.pp_desc,
query : {loc : ErrorMsg.span, numCols : int,
doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc}