Mercurial > urweb

changeset 2212:388ba4dc7c96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Small cleanup.
author Ziv Scully <ziv@mit.edu>
date Mon, 15 Sep 2014 20:01:16 -0400
parents ef766ef6e242
children 365727ff68f4
files caching-tests/test.db src/cjr_print.sml src/sql.sig src/sqlcache.sml
diffstat 4 files changed, 42 insertions(+), 45 deletions(-) [+]
line wrap: on
line diff
Binary file caching-tests/test.db has changed
--- a/src/cjr_print.sml	Sat Sep 13 19:16:07 2014 -0400
+++ b/src/cjr_print.sml	Mon Sep 15 20:01:16 2014 -0400
@@ -3393,7 +3393,7 @@
              newline,
              newline,
 
-             (* For caching. *)
+             (* For sqlcache. *)
              box (List.map
                       (fn index =>
                           let val i = Int.toString index
@@ -3403,19 +3403,21 @@
                                   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 @@
                                   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 @@
                                               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)),
--- a/src/sql.sig	Sat Sep 13 19:16:07 2014 -0400
+++ b/src/sql.sig	Mon Sep 15 20:01:16 2014 -0400
@@ -39,11 +39,7 @@
        | 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
 
--- a/src/sqlcache.sml	Sat Sep 13 19:16:07 2014 -0400
+++ b/src/sqlcache.sml	Mon Sep 15 20:01:16 2014 -0400
@@ -12,6 +12,37 @@
 
 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 @@
                           {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 @@
                 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 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