Mercurial > urweb
diff src/cjr_print.sml @ 307:52d4c60518d4
First INSERT works
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 07 Sep 2008 15:05:52 -0400 |
parents | 59dc042629b9 |
children | 9ad92047a499 |
line wrap: on
line diff
--- a/src/cjr_print.sml Sun Sep 07 14:38:14 2008 -0400 +++ b/src/cjr_print.sml Sun Sep 07 15:05:52 2008 -0400 @@ -857,6 +857,83 @@ string "})"] end + | EDml {dml, prepared} => + box [string "({", + newline, + string "PGconn *conn = lw_get_db(ctx);", + newline, + case prepared of + NONE => box [string "char *dml = ", + p_exp env dml, + string ";", + newline] + | SOME _ => + let + val ets = getPargs dml + in + box [p_list_sepi newline + (fn i => fn (e, t) => + box [p_sql_type t, + space, + string "arg", + string (Int.toString (i + 1)), + space, + string "=", + space, + p_exp env e, + string ";"]) + ets, + newline, + 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] + end, + newline, + newline, + string "PGresult *res = ", + case prepared of + NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);" + | SOME n => box [string "PQexecPrepared(conn, \"lw", + string (Int.toString n), + string "\", ", + string (Int.toString (length (getPargs dml))), + string ", paramValues, NULL, NULL, 0);"], + newline, + newline, + + string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", + newline, + newline, + + string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", + newline, + box [string "PQclear(res);", + newline, + string "lw_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 "lw_unit_v;", + newline, + string "})"] + and p_exp env = p_exp' false env fun p_fun env (fx, n, args, ran, e) =