diff src/cjr_print.sml @ 868:06497beb265b

Moved dml code into Settings
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 16:22:17 -0400
parents e7f80d78075b
children 64ba57fa20bf
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Jun 28 16:03:00 2009 -0400
+++ b/src/cjr_print.sml	Sun Jun 28 16:22:17 2009 -0400
@@ -1696,16 +1696,16 @@
       | EDml {dml, prepared} =>
         box [string "(uw_begin_region(ctx), ({",
              newline,
-             string "PGconn *conn = uw_get_db(ctx);",
-             newline,
              case prepared of
                  NONE => box [string "char *dml = ",
                               p_exp env dml,
                               string ";",
-                              newline]
-               | SOME _ =>
+                              newline,
+                              newline,
+                              #dml (Settings.currentDbms ()) loc]
+               | SOME (id, dml') =>
                  let
-                     val ets = getPargs dml
+                     val inputs = getPargs dml
                  in
                      box [p_list_sepi newline
                                       (fn i => fn (e, t) =>
@@ -1718,83 +1718,18 @@
                                                        space,
                                                        p_exp env e,
                                                        string ";"])
-                                      ets,
+                                      inputs,
                           newline,
                           newline,
 
-                          string "const int paramFormats[] = { ",
-                          p_list_sep (box [string ",", space])
-                                     (fn (_, t) => if isBlob t then string "1" else string "0") ets,
-                          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") ets,
-                          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))]))
-                                      ets,
-                          string " };",
-                          newline,
-                          newline]
+                          #dmlPrepared (Settings.currentDbms ()) {loc = loc,
+                                                                  id = id,
+                                                                  dml = dml',
+                                                                  inputs = map #2 inputs}]
                  end,
              newline,
              newline,
-             string "PGresult *res = ",
-             case prepared of
-                 NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 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,
 
-             string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
-             newline,
-             newline,
-
-             string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
-             newline,
-             box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
-                  box [newline,
-                       string "PQclear(res);",
-                       newline,
-                       string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
-                       newline],
-                  string "}",
-                  newline,
-                  string "PQclear(res);",
-                  newline,
-                  string "uw_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 "uw_end_region(ctx);",
              newline,
              string "uw_unit_v;",