aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--caching-tests/test.ur1
-rw-r--r--src/c/urweb.c7
-rw-r--r--src/cjr_print.sml14
-rw-r--r--src/compiler.sig5
-rw-r--r--src/compiler.sml9
-rw-r--r--src/main.mlton.sml12
-rw-r--r--src/sources9
-rw-r--r--src/sql.sml20
-rw-r--r--src/sqlcache.sig6
-rw-r--r--src/sqlcache.sml (renamed from src/sql_cache.sml)6
10 files changed, 46 insertions, 43 deletions
diff --git a/caching-tests/test.ur b/caching-tests/test.ur
index d13379a8..a99a387b 100644
--- a/caching-tests/test.ur
+++ b/caching-tests/test.ur
@@ -2,7 +2,6 @@ table foo01 : {Id : int, Bar : string} PRIMARY KEY Id
table foo10 : {Id : int, Bar : string} PRIMARY KEY Id
fun flush01 () : transaction page =
- dml (INSERT INTO foo01 (Id, Bar) VALUES (42, "baz01"));
dml (UPDATE foo01 SET Bar = "baz01" WHERE Id = 42);
return <xml><body>
Flushed 1!
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 10bbf930..57762da8 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1667,16 +1667,11 @@ void uw_write(uw_context ctx, const char* s) {
}
void uw_recordingStart(uw_context ctx) {
- // TODO: remove following debug statement.
- uw_write(ctx, "<!--Recording started here-->");
ctx->recording = ctx->page.front;
}
char *uw_recordingRead(uw_context ctx) {
- char *recording = strdup(ctx->recording);
- // TODO: remove following debug statement.
- uw_write(ctx, "<!--Recording read here-->");
- return recording;
+ return strdup(ctx->recording);
}
char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) {
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index ecd29f71..af2340fe 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3388,9 +3388,9 @@ fun p_file env (ds, ps) =
newline,
string "static uw_Basis_bool uw_Cache_check",
string i,
- string "(uw_context ctx) { puts(\"Checked ",
+ string "(uw_context ctx) { puts(\"Checked cache ",
string i,
- string "\"); if (cache",
+ string ".\"); if (cache",
string i,
string " == NULL) { uw_recordingStart(ctx); return uw_Basis_False; } else { uw_write(ctx, cache",
string i,
@@ -3400,9 +3400,9 @@ fun p_file env (ds, ps) =
string i,
string "(uw_context ctx) { cache",
string i,
- string " = uw_recordingRead(ctx); puts(\"Stored ",
+ string " = uw_recordingRead(ctx); puts(\"Stored cache ",
string i,
- string "\"); return uw_unit_v; };",
+ string ".\"); return uw_unit_v; };",
newline,
string "static uw_unit uw_Cache_flush",
string i,
@@ -3410,9 +3410,9 @@ fun p_file env (ds, ps) =
string i,
string "); cache",
string i,
- string " = NULL; puts(\"Flushed ",
+ string " = NULL; puts(\"Flushed cache ",
string i,
- string "\"); return uw_unit_v; };",
+ string ".\"); return uw_unit_v; };",
newline,
string "static uw_unit uw_Cache_ready",
string i,
@@ -3420,7 +3420,7 @@ fun p_file env (ds, ps) =
newline,
newline]
end)
- (!SqlCache.ffiIndices)),
+ (!Sqlcache.ffiIndices)),
newline,
p_list_sep newline (fn x => x) pds,
diff --git a/src/compiler.sig b/src/compiler.sig
index a0a653a7..81d92694 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -122,7 +122,7 @@ signature COMPILER = sig
val pathcheck : (Mono.file, Mono.file) phase
val sidecheck : (Mono.file, Mono.file) phase
val sigcheck : (Mono.file, Mono.file) phase
- val sqlCache : (Mono.file, Mono.file) phase
+ val sqlcache : (Mono.file, Mono.file) phase
val cjrize : (Mono.file, Cjr.file) phase
val prepare : (Cjr.file, Cjr.file) phase
val checknest : (Cjr.file, Cjr.file) phase
@@ -187,7 +187,7 @@ signature COMPILER = sig
val toPathcheck : (string, Mono.file) transform
val toSidecheck : (string, Mono.file) transform
val toSigcheck : (string, Mono.file) transform
- val toSqlCache : (string, Mono.file) transform
+ val toSqlcache : (string, Mono.file) transform
val toCjrize : (string, Cjr.file) transform
val toPrepare : (string, Cjr.file) transform
val toChecknest : (string, Cjr.file) transform
@@ -198,6 +198,7 @@ signature COMPILER = sig
val enableBoot : unit -> unit
val doIflow : bool ref
+ val doSqlcache : bool ref
val addPath : string * string -> unit
val addModuleRoot : string * string -> unit
diff --git a/src/compiler.sml b/src/compiler.sml
index cbc6478d..26e07e2a 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -83,6 +83,7 @@ type ('src, 'dst) transform = {
val debug = ref false
val dumpSource = ref false
val doIflow = ref false
+val doSqlcache = ref false
val doDumpSource = ref (fn () => ())
@@ -1439,19 +1440,19 @@ val sigcheck = {
val toSigcheck = transform sigcheck "sigcheck" o toSidecheck
-val sqlCache = {
- func = SqlCache.go,
+val sqlcache = {
+ func = (fn file => (if !doSqlcache then Sqlcache.go file else file)),
print = MonoPrint.p_file MonoEnv.empty
}
-val toSqlCache = transform sqlCache "sqlCache" o toSigcheck
+val toSqlcache = transform sqlcache "sqlcache" o toSigcheck
val cjrize = {
func = Cjrize.cjrize,
print = CjrPrint.p_file CjrEnv.empty
}
-val toCjrize = transform cjrize "cjrize" o toSqlCache
+val toCjrize = transform cjrize "cjrize" o toSqlcache
val prepare = {
func = Prepare.prepare,
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index bfc18e59..5ecd7290 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -16,7 +16,7 @@
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
@@ -47,6 +47,7 @@ fun oneRun args =
Elaborate.unifyMore := false;
Compiler.dumpSource := false;
Compiler.doIflow := false;
+ Compiler.doSqlcache := false;
Demo.noEmacs := false;
Settings.setDebug false)
@@ -64,7 +65,7 @@ fun oneRun args =
fun doArgs args =
case args of
[] => ()
- | "-version" :: rest =>
+ | "-version" :: rest =>
printVersion ()
| "-numeric-version" :: rest =>
printNumericVersion ()
@@ -159,6 +160,9 @@ fun oneRun args =
| "-iflow" :: rest =>
(Compiler.doIflow := true;
doArgs rest)
+ | "-sqlcache" :: rest =>
+ (Compiler.doSqlcache := true;
+ doArgs rest)
| "-moduleOf" :: fname :: _ =>
(print (Compiler.moduleOf fname ^ "\n");
raise Code OS.Process.success)
@@ -306,7 +310,7 @@ val () = case CommandLine.arguments () of
(* Redirect the daemon's output to the socket. *)
redirect Posix.FileSys.stdout;
redirect Posix.FileSys.stderr;
-
+
loop' ("", []);
Socket.close sock;
@@ -325,7 +329,7 @@ val () = case CommandLine.arguments () of
loop ()
end)
| ["daemon", "stop"] =>
- (OS.FileSys.remove socket handle OS.SysErr _ => OS.Process.exit OS.Process.success)
+ (OS.FileSys.remove socket handle OS.SysErr _ => OS.Process.exit OS.Process.success)
| args =>
let
val sock = UnixSock.Strm.socket ()
diff --git a/src/sources b/src/sources
index b468c9a5..a87678f9 100644
--- a/src/sources
+++ b/src/sources
@@ -189,10 +189,6 @@ $(SRC)/fuse.sml
$(SRC)/sql.sig
$(SRC)/sql.sml
-$(SRC)/multimap_fn.sml
-
-$(SRC)/sql_cache.sml
-
$(SRC)/iflow.sig
$(SRC)/iflow.sml
@@ -211,6 +207,11 @@ $(SRC)/sidecheck.sml
$(SRC)/sigcheck.sig
$(SRC)/sigcheck.sml
+$(SRC)/multimap_fn.sml
+
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
$(SRC)/cjr.sml
$(SRC)/postgres.sig
diff --git a/src/sql.sml b/src/sql.sml
index 8642c9d2..11df715c 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -177,10 +177,10 @@ val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >=
else
NONE)
-val field = wrap (follow t_ident
- (follow (const ".")
- uw_ident))
- (fn (t, ((), f)) => (t, f))
+val field = wrap (follow (opt (follow t_ident (const ".")))
+ uw_ident)
+ (fn (SOME (t, ()), f) => (t, f)
+ | (NONE, f) => ("T", f)) (* Should probably deal with this MySQL/SQLite case better some day. *)
datatype Rel =
Exps of exp * exp -> prop
@@ -396,22 +396,22 @@ val insert = log "insert"
val delete = log "delete"
(wrap (follow (const "DELETE FROM ")
(follow uw_ident
- (follow (const " AS T_T WHERE ")
+ (follow (follow (opt (const " AS T_T")) (const " WHERE "))
sqexp)))
- (fn ((), (tab, ((), es))) => (tab, es)))
+ (fn ((), (tab, (_, es))) => (tab, es)))
val setting = log "setting"
- (wrap (follow uw_ident (follow (const " = ") sqexp))
- (fn (f, ((), e)) => (f, e)))
+ (wrap (follow uw_ident (follow (const " = ") sqexp))
+ (fn (f, ((), e)) => (f, e)))
val update = log "update"
(wrap (follow (const "UPDATE ")
(follow uw_ident
- (follow (const " AS T_T SET ")
+ (follow (follow (opt (const " AS T_T")) (const " SET "))
(follow (list setting)
(follow (ws (const "WHERE "))
sqexp)))))
- (fn ((), (tab, ((), (fs, ((), e))))) =>
+ (fn ((), (tab, (_, (fs, ((), e))))) =>
(tab, fs, e)))
val dml = log "dml"
diff --git a/src/sqlcache.sig b/src/sqlcache.sig
new file mode 100644
index 00000000..ccc1741a
--- /dev/null
+++ b/src/sqlcache.sig
@@ -0,0 +1,6 @@
+signature SQLCACHE = sig
+
+val ffiIndices : int list ref
+val go : Mono.file -> Mono.file
+
+end
diff --git a/src/sql_cache.sml b/src/sqlcache.sml
index 7f9d98d0..2e7f6e42 100644
--- a/src/sql_cache.sml
+++ b/src/sqlcache.sml
@@ -1,4 +1,4 @@
-structure SqlCache = struct
+structure Sqlcache :> SQLCACHE = struct
open Sql
open Mono
@@ -11,8 +11,6 @@ structure SM = BinaryMapFn (StringKey)
structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS)
val ffiIndices : int list ref = ref []
-val rs : int list ref = ref []
-val ws : int list ref = ref []
val rec tablesRead =
fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs)
@@ -177,8 +175,6 @@ fun go file =
val {readers, writers} = handlerIndices file
val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers)
in
- rs := IS.listItems readers;
- ws := IS.listItems writers;
ffiIndices := IS.listItems readers;
addCacheFlushing (fileWithChecks, tablesToIndices, writers)
end
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 05:34:52 +0000