Small cleanup.

4 files changed, 42 insertions, 45 deletions

diff --git a/caching-tests/test.db b/caching-tests/test.db
index 190d2868..a5c91e8f 100644
--- a/caching-tests/test.db
+++ b/caching-tests/test.db
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b2e8d2a7..8ca35234 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3393,7 +3393,7 @@ fun p_file env (ds, ps) =
              newline,
              newline,
 
-             (* For caching. *)
+             (* For sqlcache. *)
              box (List.map
                       (fn index =>
                           let val i = Int.toString index
@@ -3403,19 +3403,21 @@ fun p_file env (ds, ps) =
                                   newline,
                                   string "static uw_Basis_bool uw_Cache_check",
                                   string i,
-                                  string "(uw_context ctx) { puts(\"Checked cache ",
+                                  string "(uw_context ctx) { puts(\"SQLCACHE: checked ",
                                   string i,
                                   string ".\"); if (cache",
                                   string i,
                                   string " == NULL) { uw_recordingStart(ctx); return uw_Basis_False; } else { uw_write(ctx, cache",
                                   string i,
-                                  string "); return uw_Basis_True; } };",
+                                  string "); puts(\"SQLCACHE: used ",
+                                  string i,
+                                  string ".\"); return uw_Basis_True; } };",
                                   newline,
                                   string "static uw_unit uw_Cache_store",
                                   string i,
                                   string "(uw_context ctx) { cache",
                                   string i,
-                                  string " = uw_recordingRead(ctx); puts(\"Stored cache ",
+                                  string " = uw_recordingRead(ctx); puts(\"SQLCACHE: stored ",
                                   string i,
                                   string ".\"); return uw_unit_v; };",
                                   newline,
@@ -3425,7 +3427,7 @@ fun p_file env (ds, ps) =
                                   string i,
                                   string "); cache",
                                   string i,
-                                  string " = NULL; puts(\"Flushed cache ",
+                                  string " = NULL; puts(\"SQLCACHE: flushed ",
                                   string i,
                                   string ".\"); return uw_unit_v; };",
                                   newline,
@@ -3564,7 +3566,7 @@ fun p_file env (ds, ps) =
                                               newline,
                                               string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
                                               newline,
-                                              string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),                  
+                                              string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
                                               newline,
                                               string "uw_replace_page(ctx, \"",
                                               string (hexify (#Bytes r)),
diff --git a/src/sql.sig b/src/sql.sig
index 573a8baf..2623f5e7 100644
--- a/src/sql.sig
+++ b/src/sql.sig
@@ -39,11 +39,7 @@ datatype prop =
        | Reln of reln * exp list
        | Cond of exp * prop
 
-datatype chunk =
-         String of string
-       | Exp of Mono.exp
-
-type 'a parser = chunk list -> ('a * chunk list) option
+type 'a parser
 
 val parse : 'a parser -> Mono.exp -> 'a option
 
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 2e7f6e42..b01de4c9 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -12,6 +12,37 @@ structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS)
 
 val ffiIndices : int list ref = ref []
 
+(* Expression construction utilities. *)
+
+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 ((exp :: exps), loc) =
+    List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) exp exps
+
+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
+
+(* Program analysis and augmentation. *)
+
 val rec tablesRead =
  fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs)
   | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2)
@@ -47,37 +78,6 @@ val tablesInExp =
                           {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)) =
@@ -85,7 +85,7 @@ fun addCacheCheck (index, exp) =
                 val check = ffiAppExp ("Cache", "check", index, loc)
                 val store = ffiAppExp ("Cache", "store", index, loc)
             in
-                antiguardUnit (check, sequence ([], body, [store], loc), loc)
+                antiguardUnit (check, sequence ([body, store], loc), loc)
             end
     in
         underAbs f exp
@@ -99,9 +99,8 @@ fun addCacheFlush (exp, tablesToIndices) =
                 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)
+                sequence (mapFfi "flush" flushes @ [body] @ mapFfi "ready" flushes, loc)
             end
     in
         underAbs f exp