diff src/cjr_print.sml @ 2204:01c8aceac480

Finishes initial prototype, caching parameterless pages with table-match-based invalidation. Still has problems parsing non-Postgres SQL dialects properly.
author Ziv Scully <ziv@mit.edu>
date Tue, 27 May 2014 21:14:13 -0400
parents ac1be85e91ad
children 0ca11d57c175
line wrap: on
line diff
--- a/src/cjr_print.sml	Tue Mar 25 02:04:06 2014 -0400
+++ b/src/cjr_print.sml	Tue May 27 21:14:13 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
@@ -734,7 +734,7 @@
                                                  string (Int.toString (size has_arg)),
                                                  string ", ((*request)[0] == '/' ? ++*request : NULL), ",
                                                  newline,
-                                                 
+
                                                  if unboxable then
                                                      unurlify' "(*request)" (#1 t)
                                                  else
@@ -914,7 +914,7 @@
                                               space,
                                               string "4, ((*request)[0] == '/' ? ++*request : NULL), ",
                                               newline,
-                                              
+
                                               string "({",
                                               newline,
                                               p_typ env (t, loc),
@@ -1188,7 +1188,7 @@
                          string "(ctx,",
                          space,
                          string "it",
-                         string (Int.toString level), 
+                         string (Int.toString level),
                          string ");",
                          newline]
                 else
@@ -1388,7 +1388,7 @@
                           string (Int.toString level),
                           string ");",
                           newline])
-                    
+
               | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function";
                       space)
     in
@@ -1578,7 +1578,7 @@
                                     newline],
                  string "tmp;",
                  newline,
-                 string "})"]          
+                 string "})"]
         end
       | ENone _ => string "NULL"
       | ESome (t, e) =>
@@ -2078,7 +2078,7 @@
                      space,
                      p_exp' false false (E.pushERel
                                              (E.pushERel env "r" (TRecord rnum, loc))
-                                             "acc" state) 
+                                             "acc" state)
                             body,
                      string ";",
                      newline]
@@ -2102,7 +2102,7 @@
                  newline,
                  string "uw_ensure_transaction(ctx);",
                  newline,
-                 
+
                  case prepared of
                      NONE =>
                      box [string "char *query = ",
@@ -2187,7 +2187,7 @@
                           string "uw_ensure_transaction(ctx);",
                           newline,
                           newline,
-                          
+
                           #dmlPrepared (Settings.currentDbms ()) {loc = loc,
                                                                   id = id,
                                                                   dml = dml',
@@ -3378,6 +3378,50 @@
              newline,
              newline,
 
+             (* For caching. *)
+             box (List.map
+                      (fn index =>
+                          let val i = Int.toString index
+                          in box [string "static char *cache",
+                                  string i,
+                                  string " = NULL;",
+                                  newline,
+                                  string "static uw_Basis_bool uw_Cache_check",
+                                  string i,
+                                  string "(uw_context ctx) { puts(\"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; } };",
+                                  newline,
+                                  string "static uw_unit uw_Cache_store",
+                                  string i,
+                                  string "(uw_context ctx) { cache",
+                                  string i,
+                                  string " = uw_recordingRead(ctx); puts(\"Stored ",
+                                  string i,
+                                  string "\"); return uw_unit_v; };",
+                                  newline,
+                                  string "static uw_unit uw_Cache_flush",
+                                  string i,
+                                  string "(uw_context ctx) { free(cache",
+                                  string i,
+                                  string "); cache",
+                                  string i,
+                                  string " = NULL; puts(\"Flushed ",
+                                  string i,
+                                  string "\"); return uw_unit_v; };",
+                                  newline,
+                                  string "static uw_unit uw_Cache_ready",
+                                  string i,
+                                  string "(uw_context ctx) { return uw_unit_v; };",
+                                  newline,
+                                  newline]
+                          end)
+                      (!SqlCache.ffiIndices)),
+             newline,
 
              p_list_sep newline (fn x => x) pds,
              newline,
@@ -3433,7 +3477,7 @@
 
              makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()),
              newline,
-             
+
              string "extern void uw_sign(const char *in, char *out);",
              newline,
              string "extern int uw_hash_blocksize;",
@@ -3480,7 +3524,7 @@
                   newline,
                   string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\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_write(ctx, jslib);",
                   newline,