From 6b85dbb54d5d9928a53f0f916cf0cb33c04ff87c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sat, 12 Mar 2016 14:11:27 -0500
Subject: Sqlcache: also record script additions; do a MonoReduce afterward, to
 help Prepare do a better job

---
 src/c/urweb.c     | 14 ++++++++++++--
 src/lru_cache.sml |  4 ++++
 src/sources       |  6 +++---
 src/sqlcache.sml  |  3 ++-
 4 files changed, 21 insertions(+), 6 deletions(-)

(limited to 'src')

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 620893c0..51a122d0 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -505,7 +505,7 @@ struct uw_context {
 
   // Sqlcache.
   int numRecording, recordingCapacity;
-  int *recordingOffsets;
+  int *recordingOffsets, *scriptRecordingOffsets;
   uw_Sqlcache_Update *cacheUpdate;
   uw_Sqlcache_Update *cacheUpdateTail;
   uw_Sqlcache_Unlock *cacheUnlock;
@@ -597,6 +597,7 @@ uw_context uw_init(int id, uw_loggers *lg) {
   ctx->numRecording = 0;
   ctx->recordingCapacity = 0;
   ctx->recordingOffsets = malloc(0);
+  ctx->scriptRecordingOffsets = malloc(0);
   ctx->cacheUpdate = NULL;
   ctx->cacheUpdateTail = NULL;
 
@@ -670,6 +671,7 @@ void uw_free(uw_context ctx) {
   free(ctx->output_buffer);
 
   free(ctx->recordingOffsets);
+  free(ctx->scriptRecordingOffsets);
 
   free(ctx);
 }
@@ -1757,13 +1759,20 @@ void uw_recordingStart(uw_context ctx) {
   if (ctx->numRecording == ctx->recordingCapacity) {
     ++ctx->recordingCapacity;
     ctx->recordingOffsets = realloc(ctx->recordingOffsets, sizeof(int) * ctx->recordingCapacity);
+    ctx->scriptRecordingOffsets = realloc(ctx->scriptRecordingOffsets, sizeof(int) * ctx->recordingCapacity);
   }
   ctx->recordingOffsets[ctx->numRecording] = ctx->page.front - ctx->page.start;
+  ctx->scriptRecordingOffsets[ctx->numRecording] = ctx->script.front - ctx->script.start;
   ++ctx->numRecording;
 }
 
 char *uw_recordingRead(uw_context ctx) {
-  char *recording = ctx->page.start + ctx->recordingOffsets[--ctx->numRecording];
+  char *recording = ctx->page.start + ctx->recordingOffsets[ctx->numRecording-1];
+  return strdup(recording);
+}
+
+char *uw_recordingReadScript(uw_context ctx) {
+  char *recording = ctx->script.start + ctx->scriptRecordingOffsets[--ctx->numRecording];
   return strdup(recording);
 }
 
@@ -4587,6 +4596,7 @@ static void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) {
   if (value) {
     free(value->result);
     free(value->output);
+    free(value->scriptOutput);
     free(value);
   }
 }
diff --git a/src/lru_cache.sml b/src/lru_cache.sml
index 81000458..f582bf6f 100644
--- a/src/lru_cache.sml
+++ b/src/lru_cache.sml
@@ -116,6 +116,8 @@ fun setupQuery {index, params} =
              newline,*)
              string "    uw_write(ctx, v->output);",
              newline,
+             string "    uw_write_script(ctx, v->scriptOutput);",
+             newline,
              string "    return v->result;",
              newline,
              string "  } else {",
@@ -148,6 +150,8 @@ fun setupQuery {index, params} =
              newline,
              string "  v->output = uw_recordingRead(ctx);",
              newline,
+             string "  v->scriptOutput = uw_recordingReadScript(ctx);",
+             newline,
              (*string ("  puts(\"SQLCACHE: stored " ^ i ^ ".\");"),
              newline,*)
              string ("  uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"),
diff --git a/src/sources b/src/sources
index 8bf80bc6..1a09e7e8 100644
--- a/src/sources
+++ b/src/sources
@@ -186,9 +186,6 @@ $(SRC)/cache.sml
 $(SRC)/toy_cache.sml
 $(SRC)/lru_cache.sml
 
-$(SRC)/sqlcache.sig
-$(SRC)/sqlcache.sml
-
 $(SRC)/monoize.sig
 $(SRC)/monoize.sml
 
@@ -210,6 +207,9 @@ $(SRC)/fuse.sml
 $(SRC)/iflow.sig
 $(SRC)/iflow.sml
 
+$(SRC)/sqlcache.sig
+$(SRC)/sqlcache.sml
+
 $(SRC)/name_js.sig
 $(SRC)/name_js.sml
 
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 570c7d45..c97daac2 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -1724,8 +1724,9 @@ fun go file =
         (* Important that this happens after [MonoFooify.urlify] calls! *)
         val fmDecls = MonoFooify.getNewFmDecls ()
         val () = Sql.sqlcacheMode := false
+        val file = insertAfterDatatypes (file, rev fmDecls)
     in
-        insertAfterDatatypes (file, rev fmDecls)
+        MonoReduce.reduce file
     end
 
 end
-- 
cgit v1.2.3