diff options
author | 2009-07-17 17:03:37 -0400 | |
---|---|---|
committer | 2009-07-17 17:03:37 -0400 | |
commit | 7ad34807bd19c3ad0c84a30401c1fafc37e59775 (patch) | |
tree | 81195938120b587d5dfe18fc3907b130b9d18ce2 /src | |
parent | 0c42fe7e8be44f7314e53259c33f6e45fe3078d9 (diff) |
Most of demo working with SQLite
Diffstat (limited to 'src')
-rw-r--r-- | src/monoize.sml | 42 | ||||
-rw-r--r-- | src/mysql.sml | 1 | ||||
-rw-r--r-- | src/postgres.sml | 1 | ||||
-rw-r--r-- | src/settings.sig | 1 | ||||
-rw-r--r-- | src/settings.sml | 2 | ||||
-rw-r--r-- | src/sqlite.sml | 43 |
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, |