changeset 886:5805fa825fe8

Most of demo working with SQLite
author Adam Chlipala <adamc@hcoop.net>
date Fri, 17 Jul 2009 17:03:37 -0400
parents e6070333d8a8
children 9eb479691d1c
files src/monoize.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml src/sqlite.sml
diffstat 6 files changed, 65 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/monoize.sml	Fri Jul 17 17:03:37 2009 -0400
@@ -1606,19 +1606,35 @@
                      ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                 (L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
                                           (L'.EAbs ("e", s, s,
-                                                    strcat [sc "UPDATE ",
-                                                            (L'.ERel 1, loc),
-                                                            sc " AS T SET ",
-                                                            strcatComma (map (fn (x, _) =>
-                                                                                 strcat [sc ("uw_" ^ x
-                                                                                             ^ " = "),
-                                                                                         (L'.EField
-                                                                                              ((L'.ERel 2,
-                                                                                                loc),
-                                                                                               x), loc)])
-                                                                             changed),
-                                                            sc " WHERE ",
-                                                            (L'.ERel 0, loc)]), loc)), loc)), loc),
+                                                    if #supportsUpdateAs (Settings.currentDbms ()) then
+                                                        strcat [sc "UPDATE ",
+                                                                (L'.ERel 1, loc),
+                                                                sc " AS T SET ",
+                                                                strcatComma (map (fn (x, _) =>
+                                                                                     strcat [sc ("uw_" ^ x
+                                                                                                 ^ " = "),
+                                                                                             (L'.EField
+                                                                                                  ((L'.ERel 2,
+                                                                                                    loc),
+                                                                                                   x), loc)])
+                                                                                 changed),
+                                                                sc " WHERE ",
+                                                                (L'.ERel 0, loc)]
+                                                    else
+                                                        strcat [sc "UPDATE ",
+                                                                (L'.ERel 1, loc),
+                                                                sc " SET ",
+                                                                strcatComma (map (fn (x, _) =>
+                                                                                     strcat [sc ("uw_" ^ x
+                                                                                                 ^ " = "),
+                                                                                             (L'.EField
+                                                                                                  ((L'.ERel 2,
+                                                                                                    loc),
+                                                                                                   x), loc)])
+                                                                                 changed),
+                                                                sc " WHERE ",
+                                                                (L'.EFfiApp ("Basis", "unAs", [(L'.ERel 0, loc)]), loc)]),
+                                           loc)), loc)), loc),
                       fm)
                  end
                | _ => poly ())
--- a/src/mysql.sml	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/mysql.sml	Fri Jul 17 17:03:37 2009 -0400
@@ -1446,6 +1446,7 @@
                   p_cast = p_cast,
                   p_blank = p_blank,
                   supportsDeleteAs = false,
+                  supportsUpdateAs = false,
                   createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)",
                   textKeysNeedLengths = true,
                   supportsNextval = false,
--- a/src/postgres.sml	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/postgres.sml	Fri Jul 17 17:03:37 2009 -0400
@@ -890,6 +890,7 @@
                   p_cast = p_cast,
                   p_blank = p_blank,
                   supportsDeleteAs = true,
+                  supportsUpdateAs = true,
                   createSequence = fn s => "CREATE SEQUENCE " ^ s,
                   textKeysNeedLengths = false,
                   supportsNextval = true,
--- a/src/settings.sig	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/settings.sig	Fri Jul 17 17:03:37 2009 -0400
@@ -150,6 +150,7 @@
          p_cast : string * sql_type -> string,
          p_blank : int * sql_type -> string (* Prepared statement input *),
          supportsDeleteAs : bool,
+         supportsUpdateAs : bool,
          createSequence : string -> string,
          textKeysNeedLengths : bool,
          supportsNextval : bool,
--- a/src/settings.sml	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/settings.sml	Fri Jul 17 17:03:37 2009 -0400
@@ -340,6 +340,7 @@
      p_cast : string * sql_type -> string,
      p_blank : int * sql_type -> string,
      supportsDeleteAs : bool,
+     supportsUpdateAs : bool,
      createSequence : string -> string,
      textKeysNeedLengths : bool,
      supportsNextval : bool,
@@ -363,6 +364,7 @@
                   p_cast = fn _ => "",
                   p_blank = fn _ => "",
                   supportsDeleteAs = false,
+                  supportsUpdateAs = false,
                   createSequence = fn _ => "",
                   textKeysNeedLengths = false,
                   supportsNextval = false,
--- a/src/sqlite.sml	Fri Jul 17 16:29:36 2009 -0400
+++ b/src/sqlite.sml	Fri Jul 17 17:03:37 2009 -0400
@@ -232,8 +232,14 @@
                                                                string (Int.toString i),
                                                                string ", NULL) != SQLITE_OK) {",
                                                                newline,
-                                                               uhoh false ("Error preparing statement: "
-                                                                           ^ String.toString s) [],
+                                                               box [string "char msg[1024];",
+                                                                    newline,
+                                                                    string "strncpy(msg, sqlite3_errmsg(conn->conn), 1024);",
+                                                                    newline,
+                                                                    string "msg[1023] = 0;",
+                                                                    newline,
+                                                                    uhoh false ("Error preparing statement: "
+                                                                                ^ String.toString s ^ "\\n%s") ["msg"]],
                                                                string "}",
                                                                newline]
                                                       end)
@@ -379,7 +385,17 @@
                              string "b;",
                              newline,
                              string "})"]
-              | Channel => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
+              | Channel => box [string "({",
+                                newline,
+                                string "sqlite3_int64 n = sqlite3_column_int64(stmt, ",
+                                string (Int.toString i),
+                                string ");",
+                                newline,
+                                string "uw_Basis_channel ch = {n >> 32, n & 0xFFFFFFFF};",
+                                newline,
+                                string "ch;",
+                                newline,
+                                string "})"]
               | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
 
               | Nullable _ => raise Fail "Postgres: Recursive Nullable"
@@ -469,7 +485,7 @@
 fun query {loc, cols, doCols} =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
-         string "sqlite3 *stmt;",
+         string "sqlite3_stmt *stmt;",
          newline,
          newline,
          string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", sqlite3_errmsg(conn->conn));",
@@ -522,11 +538,13 @@
                                                      string ".data, ",
                                                      arg,
                                                      string ".size, SQLITE_TRANSIENT"]
-                                      | Channel => box [string "sqlite_bind_int64(stmt, ",
+                                      | Channel => box [string "sqlite3_bind_int64(stmt, ",
                                                         string (Int.toString (i + 1)),
-                                                        string ", ",
+                                                        string ", ((sqlite3_int64)",
                                                         arg,
-                                                        string ")"]
+                                                        string ".cli << 32) | ",
+                                                        arg,
+                                                        string ".chn)"]
                                       | Client => box [string "sqlite3_bind_int(stmt, ",
                                                        string (Int.toString (i + 1)),
                                                        string ", ",
@@ -629,7 +647,7 @@
 fun dml loc =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
-         string "sqlite3 *stmt;",
+         string "sqlite3_stmt *stmt;",
          newline,
          newline,
          string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", dml, sqlite3_errmsg(conn->conn));",
@@ -690,7 +708,7 @@
          newline,
          string "char *insert = ",
          case seqName of
-             SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
+             SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES (NULL)\"")
            | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
                           seqE,
                           string ", \" VALUES ()\"))"],
@@ -706,11 +724,11 @@
          newline,
          newline,
 
-         string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
+         string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed: %s\", sqlite3_errmsg(conn->conn));",
          newline,
          string "n = sqlite3_last_insert_rowid(conn->conn);",
          newline,
-         string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
+         string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed: %s\", sqlite3_errmsg(conn->conn));",
          newline]
 
 fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
@@ -744,7 +762,8 @@
                   p_cast = p_cast,
                   p_blank = p_blank,
                   supportsDeleteAs = false,
-                  createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTO INCREMENT)",
+                  supportsUpdateAs = false,
+                  createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTOINCREMENT)",
                   textKeysNeedLengths = false,
                   supportsNextval = false,
                   supportsNestedPrepared = false,