Mercurial > urweb
diff src/postgres.sml @ 1431:4a6f84092399
Represent 'unit' as C 'int'; change pattern match compilation to avoid 'goto'; change Postgres prepared statement compilation to make life easier for the GCC escape analysis; all this in support of better tail call optimization
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 10 Mar 2011 18:51:15 -0500 |
parents | 58c9c039582a |
children | 969b90b1f2f9 |
line wrap: on
line diff
--- a/src/postgres.sml Wed Mar 02 18:35:03 2011 -0500 +++ b/src/postgres.sml Thu Mar 10 18:51:15 2011 -0500 @@ -669,29 +669,56 @@ p_ensql t (box [string "(*", e, string ")"]), string ")"] -fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = - box [string "PGconn *conn = uw_get_db(ctx);", - newline, - string "const int paramFormats[] = { ", +fun makeParams inputs = + box [string "static const int paramFormats[] = { ", p_list_sep (box [string ",", space]) (fn t => if isBlob t then string "1" else string "0") inputs, 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") inputs, - string " };", + if List.exists isBlob inputs then + box [string "const int *paramLengths = uw_malloc(ctx, ", + string (Int.toString (length inputs)), + string " * sizeof(int));", + newline, + p_list_sepi (box []) + (fn i => fn t => + box [string "paramLengths[", + string (Int.toString i), + string "] = ", + case t of + 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", + string ";", + newline]) inputs, + string " };", + newline] + else + box [string "const int *paramLengths = paramFormats;", + newline], + + string "const char **paramValues = uw_malloc(ctx, ", + string (Int.toString (length inputs)), + string " * sizeof(char*));", 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))])) + p_list_sepi (box []) + (fn i => fn t => box [string "paramValues[", + string (Int.toString i), + string "] = ", + p_ensql t (box [string "arg", + string (Int.toString (i + 1))]), + string ";", + newline]) inputs, - string " };", + newline] + +fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = + box [string "PGconn *conn = uw_get_db(ctx);", newline, + + makeParams inputs, + newline, string "PGresult *res = ", if #persistent (Settings.currentProtocol ()) then @@ -831,26 +858,9 @@ fun dmlPrepared {loc, id, dml, inputs, mode} = box [string "PGconn *conn = uw_get_db(ctx);", newline, - string "const int paramFormats[] = { ", - p_list_sep (box [string ",", space]) - (fn t => if isBlob t then string "1" else string "0") inputs, - 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") inputs, - 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))])) - inputs, - string " };", - newline, + + makeParams inputs, + newline, string "PGresult *res;", newline,