summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-07-17 17:03:37 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-07-17 17:03:37 -0400
commit8792a4b892de36b894b44c61e6a991efd9fbe2dc (patch)
tree81195938120b587d5dfe18fc3907b130b9d18ce2
parent6c255756254997d09a47f14b77998d086e8301c2 (diff)
Most of demo working with SQLite
Diffstat
-rw-r--r--src/monoize.sml42
-rw-r--r--src/mysql.sml1
-rw-r--r--src/postgres.sml1
-rw-r--r--src/settings.sig1
-rw-r--r--src/settings.sml2
-rw-r--r--src/sqlite.sml43
6 files changed, 65 insertions, 25 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index 2e9886dd..37df70d1 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1606,19 +1606,35 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
((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 ())
diff --git a/src/mysql.sml b/src/mysql.sml
index 7314f64e..77f95f8d 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1446,6 +1446,7 @@ val () = addDbms {name = "mysql",
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,
diff --git a/src/postgres.sml b/src/postgres.sml
index a178f086..f82b567d 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -890,6 +890,7 @@ val () = addDbms {name = "postgres",
p_cast = p_cast,
p_blank = p_blank,
supportsDeleteAs = true,
+ supportsUpdateAs = true,
createSequence = fn s => "CREATE SEQUENCE " ^ s,
textKeysNeedLengths = false,
supportsNextval = true,
diff --git a/src/settings.sig b/src/settings.sig
index 92dbbab9..b0abcef2 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -150,6 +150,7 @@ signature SETTINGS = sig
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,
diff --git a/src/settings.sml b/src/settings.sml
index d1901483..08a44471 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -340,6 +340,7 @@ type dbms = {
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 @@ val curDb = ref ({name = "",
p_cast = fn _ => "",
p_blank = fn _ => "",
supportsDeleteAs = false,
+ supportsUpdateAs = false,
createSequence = fn _ => "",
textKeysNeedLengths = false,
supportsNextval = false,
diff --git a/src/sqlite.sml b/src/sqlite.sml
index a8641a8a..ce87de6d 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -232,8 +232,14 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
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 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
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 queryCommon {loc, query, cols, doCols} =
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 @@ fun p_inputs loc =
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 dmlCommon {loc, dml} =
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 @@ fun nextval {loc, seqE, seqName} =
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 @@ fun nextval {loc, seqE, seqName} =
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 @@ val () = addDbms {name = "sqlite",
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,
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-09 18:24:23 +0000