changeset 2209:0ca11d57c175

Cleans up interface (it's now a command line option) and renames project to "sqlcache" in the all-one-word style. Still has issues to do with concurrency, retrying transactions, and foreign function calls that either rely on state or have side effects.
author Ziv Scully <ziv@mit.edu>
date Sat, 31 May 2014 03:08:16 -0400 (2014-05-31)
parents cb74460f046a
children 69c0f36255cb
files caching-tests/test.ur src/c/urweb.c src/cjr_print.sml src/compiler.sig src/compiler.sml src/main.mlton.sml src/sources src/sql.sml src/sql_cache.sml src/sqlcache.sig src/sqlcache.sml
diffstat 11 files changed, 227 insertions(+), 224 deletions(-) [+]
line wrap: on
line diff
--- a/caching-tests/test.ur	Fri May 30 12:00:44 2014 -0400
+++ b/caching-tests/test.ur	Sat May 31 03:08:16 2014 -0400
@@ -2,7 +2,6 @@
 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!
--- a/src/c/urweb.c	Fri May 30 12:00:44 2014 -0400
+++ b/src/c/urweb.c	Sat May 31 03:08:16 2014 -0400
@@ -1667,16 +1667,11 @@
 }
 
 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) {
--- a/src/cjr_print.sml	Fri May 30 12:00:44 2014 -0400
+++ b/src/cjr_print.sml	Sat May 31 03:08:16 2014 -0400
@@ -3388,9 +3388,9 @@
                                   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 @@
                                   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 @@
                                   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 @@
                                   newline,
                                   newline]
                           end)
-                      (!SqlCache.ffiIndices)),
+                      (!Sqlcache.ffiIndices)),
              newline,
 
              p_list_sep newline (fn x => x) pds,
--- a/src/compiler.sig	Fri May 30 12:00:44 2014 -0400
+++ b/src/compiler.sig	Sat May 31 03:08:16 2014 -0400
@@ -122,7 +122,7 @@
     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 @@
     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 @@
     val enableBoot : unit -> unit
 
     val doIflow : bool ref
+    val doSqlcache : bool ref
 
     val addPath : string * string -> unit
     val addModuleRoot : string * string -> unit
--- a/src/compiler.sml	Fri May 30 12:00:44 2014 -0400
+++ b/src/compiler.sml	Sat May 31 03:08:16 2014 -0400
@@ -83,6 +83,7 @@
 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 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,
--- a/src/main.mlton.sml	Fri May 30 12:00:44 2014 -0400
+++ b/src/main.mlton.sml	Sat May 31 03:08:16 2014 -0400
@@ -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 @@
                   Elaborate.unifyMore := false;
                   Compiler.dumpSource := false;
                   Compiler.doIflow := false;
+                  Compiler.doSqlcache := false;
                   Demo.noEmacs := false;
                   Settings.setDebug false)
 
@@ -64,7 +65,7 @@
         fun doArgs args =
             case args of
                 [] => ()
-              | "-version" :: rest => 
+              | "-version" :: rest =>
                   printVersion ()
               | "-numeric-version" :: rest =>
                   printNumericVersion ()
@@ -159,6 +160,9 @@
               | "-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 @@
                               (* Redirect the daemon's output to the socket. *)
                               redirect Posix.FileSys.stdout;
                               redirect Posix.FileSys.stderr;
-                              
+
                               loop' ("", []);
                               Socket.close sock;
 
@@ -325,7 +329,7 @@
                       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 ()
--- a/src/sources	Fri May 30 12:00:44 2014 -0400
+++ b/src/sources	Sat May 31 03:08:16 2014 -0400
@@ -189,10 +189,6 @@
 $(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)/sigcheck.sig
 $(SRC)/sigcheck.sml
 
+$(SRC)/multimap_fn.sml
+
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
 $(SRC)/cjr.sml
 
 $(SRC)/postgres.sig
--- a/src/sql.sml	Fri May 30 12:00:44 2014 -0400
+++ b/src/sql.sml	Sat May 31 03:08:16 2014 -0400
@@ -177,10 +177,10 @@
                                     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 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"
--- a/src/sql_cache.sml	Fri May 30 12:00:44 2014 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,186 +0,0 @@
-structure SqlCache = struct
-
-open Sql
-open Mono
-
-structure IS = IntBinarySet
-structure IM = IntBinaryMap
-structure StringKey = struct type ord_key = string val compare = String.compare end
-structure SS = BinarySetFn (StringKey)
-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)
-  | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2)
-
-val tableWritten =
- fn Insert (tab, _) => tab
-  | Delete (tab, _) => tab
-  | Update (tab, _, _) => tab
-
-fun tablesInExp' exp' =
-    let
-        val nothing = {read = SS.empty, written = SS.empty}
-    in
-        case exp' of
-            EQuery {query=e, ...} =>
-            (case parse query e of
-                 SOME q => {read = tablesRead q, written = SS.empty}
-               | NONE => nothing)
-          | EDml (e, _) =>
-            (case parse dml e of
-                 SOME q => {read = SS.empty, written = SS.singleton (tableWritten q)}
-               | NONE => nothing)
-          | _ => nothing
-    end
-
-val tablesInExp =
-    let
-        fun addTables (exp', {read, written}) =
-            let val {read = r, written = w} = tablesInExp' exp'
-            in {read = SS.union (r, read), written = SS.union (w, written)} end
-    in
-        MonoUtil.Exp.fold {typ = #2, exp = addTables}
-                          {read = SS.empty, written = SS.empty}
-    end
-
-fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc)
-fun intTyp loc = (TFfi ("Basis", "int"), loc)
-fun boolPat (b, loc) = (PCon (Enum,
-                              PConFfi {mod = "Basis", datatyp = "bool", arg = NONE,
-                                       con = if b then "True" else "False"},
-                              NONE),
-                        loc)
-fun boolTyp loc = (TFfi ("Basis", "int"), loc)
-
-fun ffiAppExp (module, func, index, loc) =
-    (EFfiApp (module, func ^ Int.toString index, []), loc)
-
-fun sequence (befores, center, afters, loc) =
-    List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc))
-               (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc))
-                           center
-                           afters)
-               befores
-
-fun antiguardUnit (cond, exp, loc) =
-    (ECase (cond,
-            [(boolPat (false, loc), exp),
-             (boolPat (true, loc), (ERecord [], loc))],
-            {disc = boolTyp loc, result = (TRecord [], loc)}),
-     loc)
-
-fun underAbs f (exp as (exp', loc)) =
-    case exp' of
-        EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc)
-      | _ => f exp
-
-fun addCacheCheck (index, exp) =
-    let
-        fun f (body as (_, loc)) =
-            let
-                val check = ffiAppExp ("Cache", "check", index, loc)
-                val store = ffiAppExp ("Cache", "store", index, loc)
-            in
-                antiguardUnit (check, sequence ([], body, [store], loc), loc)
-            end
-    in
-        underAbs f exp
-    end
-
-fun addCacheFlush (exp, tablesToIndices) =
-    let
-        fun addIndices (table, indices) = IS.union (indices, SIMM.find (tablesToIndices, table))
-        fun f (body as (_, loc)) =
-            let
-                fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc))
-                val flushes =
-                    IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body)))
-
-            in
-                sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc)
-            end
-    in
-        underAbs f exp
-    end
-
-val handlerIndices =
-    let
-        val isUnit =
-         fn (TRecord [], _) => true
-          | _ => false
-        fun maybeAdd (d, soFar as {readers, writers}) =
-            case d of
-                DExport (Link ReadOnly, _, name, typs, typ, _) =>
-                if List.all isUnit (typ::typs)
-                then {readers = IS.add (readers, name), writers = writers}
-                else soFar
-              | DExport (_, _, name, _, _, _) => (* Not read only. *)
-                {readers = readers, writers = IS.add (writers, name)}
-              | _ => soFar
-    in
-        MonoUtil.File.fold {typ = #2, exp = #2, decl = maybeAdd}
-                           {readers = IS.empty, writers = IS.empty}
-    end
-
-fun fileFoldMapiSelected f init (file, indices) =
-    let
-        fun doExp (original as ((a, index, b, exp, c), state)) =
-            if IS.member (indices, index)
-            then let val (newExp, newState) = f (index, exp, state)
-                 in ((a, index, b, newExp, c), newState) end
-            else original
-        fun doDecl decl state =
-            let
-                val result =
-                    case decl of
-                        DVal x =>
-                        let val (y, newState) = doExp (x, state)
-                        in (DVal y, newState) end
-                      | DValRec xs =>
-                        let val (ys, newState) = ListUtil.foldlMap doExp state xs
-                        in (DValRec ys, newState) end
-                      | _ => (decl, state)
-            in
-                Search.Continue result
-            end
-        fun nada x y = Search.Continue (x, y)
-    in
-        case MonoUtil.File.mapfold {typ = nada, exp = nada, decl = doDecl} file init of
-            Search.Continue x => x
-          | _ => (file, init) (* Should never happen. *)
-    end
-
-fun fileMapSelected f = #1 o fileFoldMapiSelected (fn (_, x, _) => (f x, ())) ()
-
-val addCacheChecking =
-    let
-        fun f (index, exp, tablesToIndices) =
-            (addCacheCheck (index, exp),
-             SS.foldr (fn (table, tsToIs) => SIMM.insert (tsToIs, table, index))
-                      tablesToIndices
-                      (#read (tablesInExp exp)))
-    in
-        fileFoldMapiSelected f (SM.empty)
-    end
-
-fun addCacheFlushing (file, tablesToIndices, writers) =
-    fileMapSelected (fn exp => addCacheFlush (exp, tablesToIndices)) (file, writers)
-
-fun go file =
-    let
-        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
-
-end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sqlcache.sig	Sat May 31 03:08:16 2014 -0400
@@ -0,0 +1,6 @@
+signature SQLCACHE = sig
+
+val ffiIndices : int list ref
+val go : Mono.file -> Mono.file
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sqlcache.sml	Sat May 31 03:08:16 2014 -0400
@@ -0,0 +1,182 @@
+structure Sqlcache :> SQLCACHE = struct
+
+open Sql
+open Mono
+
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+structure StringKey = struct type ord_key = string val compare = String.compare end
+structure SS = BinarySetFn (StringKey)
+structure SM = BinaryMapFn (StringKey)
+structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS)
+
+val ffiIndices : int list ref = ref []
+
+val rec tablesRead =
+ fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs)
+  | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2)
+
+val tableWritten =
+ fn Insert (tab, _) => tab
+  | Delete (tab, _) => tab
+  | Update (tab, _, _) => tab
+
+fun tablesInExp' exp' =
+    let
+        val nothing = {read = SS.empty, written = SS.empty}
+    in
+        case exp' of
+            EQuery {query=e, ...} =>
+            (case parse query e of
+                 SOME q => {read = tablesRead q, written = SS.empty}
+               | NONE => nothing)
+          | EDml (e, _) =>
+            (case parse dml e of
+                 SOME q => {read = SS.empty, written = SS.singleton (tableWritten q)}
+               | NONE => nothing)
+          | _ => nothing
+    end
+
+val tablesInExp =
+    let
+        fun addTables (exp', {read, written}) =
+            let val {read = r, written = w} = tablesInExp' exp'
+            in {read = SS.union (r, read), written = SS.union (w, written)} end
+    in
+        MonoUtil.Exp.fold {typ = #2, exp = addTables}
+                          {read = SS.empty, written = SS.empty}
+    end
+
+fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc)
+fun intTyp loc = (TFfi ("Basis", "int"), loc)
+fun boolPat (b, loc) = (PCon (Enum,
+                              PConFfi {mod = "Basis", datatyp = "bool", arg = NONE,
+                                       con = if b then "True" else "False"},
+                              NONE),
+                        loc)
+fun boolTyp loc = (TFfi ("Basis", "int"), loc)
+
+fun ffiAppExp (module, func, index, loc) =
+    (EFfiApp (module, func ^ Int.toString index, []), loc)
+
+fun sequence (befores, center, afters, loc) =
+    List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc))
+               (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc))
+                           center
+                           afters)
+               befores
+
+fun antiguardUnit (cond, exp, loc) =
+    (ECase (cond,
+            [(boolPat (false, loc), exp),
+             (boolPat (true, loc), (ERecord [], loc))],
+            {disc = boolTyp loc, result = (TRecord [], loc)}),
+     loc)
+
+fun underAbs f (exp as (exp', loc)) =
+    case exp' of
+        EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc)
+      | _ => f exp
+
+fun addCacheCheck (index, exp) =
+    let
+        fun f (body as (_, loc)) =
+            let
+                val check = ffiAppExp ("Cache", "check", index, loc)
+                val store = ffiAppExp ("Cache", "store", index, loc)
+            in
+                antiguardUnit (check, sequence ([], body, [store], loc), loc)
+            end
+    in
+        underAbs f exp
+    end
+
+fun addCacheFlush (exp, tablesToIndices) =
+    let
+        fun addIndices (table, indices) = IS.union (indices, SIMM.find (tablesToIndices, table))
+        fun f (body as (_, loc)) =
+            let
+                fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc))
+                val flushes =
+                    IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body)))
+
+            in
+                sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc)
+            end
+    in
+        underAbs f exp
+    end
+
+val handlerIndices =
+    let
+        val isUnit =
+         fn (TRecord [], _) => true
+          | _ => false
+        fun maybeAdd (d, soFar as {readers, writers}) =
+            case d of
+                DExport (Link ReadOnly, _, name, typs, typ, _) =>
+                if List.all isUnit (typ::typs)
+                then {readers = IS.add (readers, name), writers = writers}
+                else soFar
+              | DExport (_, _, name, _, _, _) => (* Not read only. *)
+                {readers = readers, writers = IS.add (writers, name)}
+              | _ => soFar
+    in
+        MonoUtil.File.fold {typ = #2, exp = #2, decl = maybeAdd}
+                           {readers = IS.empty, writers = IS.empty}
+    end
+
+fun fileFoldMapiSelected f init (file, indices) =
+    let
+        fun doExp (original as ((a, index, b, exp, c), state)) =
+            if IS.member (indices, index)
+            then let val (newExp, newState) = f (index, exp, state)
+                 in ((a, index, b, newExp, c), newState) end
+            else original
+        fun doDecl decl state =
+            let
+                val result =
+                    case decl of
+                        DVal x =>
+                        let val (y, newState) = doExp (x, state)
+                        in (DVal y, newState) end
+                      | DValRec xs =>
+                        let val (ys, newState) = ListUtil.foldlMap doExp state xs
+                        in (DValRec ys, newState) end
+                      | _ => (decl, state)
+            in
+                Search.Continue result
+            end
+        fun nada x y = Search.Continue (x, y)
+    in
+        case MonoUtil.File.mapfold {typ = nada, exp = nada, decl = doDecl} file init of
+            Search.Continue x => x
+          | _ => (file, init) (* Should never happen. *)
+    end
+
+fun fileMapSelected f = #1 o fileFoldMapiSelected (fn (_, x, _) => (f x, ())) ()
+
+val addCacheChecking =
+    let
+        fun f (index, exp, tablesToIndices) =
+            (addCacheCheck (index, exp),
+             SS.foldr (fn (table, tsToIs) => SIMM.insert (tsToIs, table, index))
+                      tablesToIndices
+                      (#read (tablesInExp exp)))
+    in
+        fileFoldMapiSelected f (SM.empty)
+    end
+
+fun addCacheFlushing (file, tablesToIndices, writers) =
+    fileMapSelected (fn exp => addCacheFlush (exp, tablesToIndices)) (file, writers)
+
+fun go file =
+    let
+        val {readers, writers} = handlerIndices file
+        val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers)
+    in
+        ffiIndices := IS.listItems readers;
+        addCacheFlushing (fileWithChecks, tablesToIndices, writers)
+    end
+
+end