# HG changeset patch
# User Ziv Scully <ziv@mit.edu>
# Date 1430968290 14400
# Node ID af1585e7d64550864f2d9e8b04f4938a02faf9e5
# Parent  a07b91fa71db16faf7accd1fb9094e3b112dee31
More work factoring out Sqlcache back end.

diff -r a07b91fa71db -r af1585e7d645 src/cache.sml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cache.sml	Wed May 06 23:11:30 2015 -0400
@@ -0,0 +1,16 @@
+structure Cache = struct
+
+type cache =
+     {(* Takes a query ID and parameters (and, for store, the value to
+            store) and gives an FFI call that checks, stores, or flushes the
+            relevant entry. The parameters are strings for check and store and
+            optional strings for flush because some parameters might not be
+            fixed. *)
+      check : int * Mono.exp list -> Mono.exp',
+      store : int * Mono.exp list * Mono.exp -> Mono.exp',
+      flush : int * Mono.exp list -> Mono.exp',
+      (* Generates C needed for FFI calls in check, store, and flush. *)
+      setupGlobal : Print.PD.pp_desc,
+      setupQuery : {index : int, params : int} -> Print.PD.pp_desc}
+
+end
diff -r a07b91fa71db -r af1585e7d645 src/cjr_print.sml
--- a/src/cjr_print.sml	Wed May 06 14:51:09 2015 -0400
+++ b/src/cjr_print.sml	Wed May 06 23:11:30 2015 -0400
@@ -3404,7 +3404,11 @@
              newline,
 
              (* For sqlcache. *)
-             box (List.map ToyCache.setupQuery (Sqlcache.getFfiInfo ())),
+             let
+                 val {setupGlobal, setupQuery, ...} = Sqlcache.getCache ()
+             in
+                 box (setupGlobal :: newline :: List.map setupQuery (Sqlcache.getFfiInfo ()))
+             end,
              newline,
 
              p_list_sep newline (fn x => x) pds,
diff -r a07b91fa71db -r af1585e7d645 src/sources
--- a/src/sources	Wed May 06 14:51:09 2015 -0400
+++ b/src/sources	Wed May 06 23:11:30 2015 -0400
@@ -175,6 +175,7 @@
 
 $(SRC)/multimap_fn.sml
 
+$(SRC)/cache.sml
 $(SRC)/toy_cache.sml
 
 $(SRC)/sqlcache.sig
diff -r a07b91fa71db -r af1585e7d645 src/sqlcache.sig
--- a/src/sqlcache.sig	Wed May 06 14:51:09 2015 -0400
+++ b/src/sqlcache.sig	Wed May 06 23:11:30 2015 -0400
@@ -1,6 +1,9 @@
 signature SQLCACHE = sig
 
-val ffiIndices : int list ref
+val setCache : Cache.cache -> unit
+val getCache : unit -> Cache.cache
+
+val getFfiInfo : unit -> {index : int, params : int} list
 val go : Mono.file -> Mono.file
 
 end
diff -r a07b91fa71db -r af1585e7d645 src/sqlcache.sml
--- a/src/sqlcache.sml	Wed May 06 14:51:09 2015 -0400
+++ b/src/sqlcache.sml	Wed May 06 23:11:30 2015 -0400
@@ -1,4 +1,4 @@
-structure Sqlcache (* :> SQLCACHE *) = struct
+structure Sqlcache :> SQLCACHE = struct
 
 open Mono
 
@@ -39,6 +39,10 @@
                      andalso not (m = "Basis" andalso SS.member (fs, f))
     end
 
+val cache = ref ToyCache.cache
+fun setCache c = cache := c
+fun getCache () = !cache
+
 
 (* Effect analysis. *)
 
@@ -366,6 +370,8 @@
 
 (* Program instrumentation. *)
 
+val {check, store, flush, ...} = getCache ()
+
 val dummyLoc = ErrorMsg.dummySpan
 
 fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc)
@@ -400,8 +406,8 @@
         (* We ensure before this step that all arguments aren't effectful.
            by turning them into local variables as needed. *)
         val argsInc = map (incRels 1) args
-        val check = (ToyCache.check (i, args), dummyLoc)
-        val store = (ToyCache.store (i, argsInc, urlifiedRel0), dummyLoc)
+        val check = (check (i, args), dummyLoc)
+        val store = (store (i, argsInc, urlifiedRel0), dummyLoc)
         val rel0 = (ERel 0, loc)
     in
         ECase (check,
@@ -545,7 +551,7 @@
 fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) =
     let
         val flushes = List.concat o
-                      map (fn (i, argss) => map (fn args => ToyCache.flush (i, args)) argss)
+                      map (fn (i, argss) => map (fn args => flush (i, args)) argss)
         val doExp =
          fn EDml (origDmlText, failureMode) =>
             let
diff -r a07b91fa71db -r af1585e7d645 src/toy_cache.sml
--- a/src/toy_cache.sml	Wed May 06 14:51:09 2015 -0400
+++ b/src/toy_cache.sml	Wed May 06 23:11:30 2015 -0400
@@ -1,4 +1,7 @@
-structure ToyCache = struct
+structure ToyCache : sig
+    val cache : Cache.cache
+end = struct
+
 
 (* Mono *)
 
@@ -182,4 +185,10 @@
 
 val setupGlobal = string "/* No global setup for toy cache. */"
 
+
+(* Bundled up. *)
+
+val cache = {check = check, store = store, flush = flush,
+             setupQuery = setupQuery, setupGlobal = setupGlobal}
+
 end