From 067c8cd3b908eb057f6721453a5c3801965d43b8 Mon Sep 17 00:00:00 2001
From: Ziv Scully <ziv@mit.edu>
Date: Sun, 27 Sep 2015 14:46:12 -0400
Subject: Use referenced (rather than all) free variables as keys for pure
 caches.

---
 src/sqlcache.sml | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

(limited to 'src/sqlcache.sml')

diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index eaa94685..fa4a0d22 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -673,8 +673,8 @@ val gunk : ((Sql.query * int) * Sql.dml) list ref = ref []
 
 fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) =
     let
-        val flushes = List.concat o
-                      map (fn (i, argss) => map (fn args => flush (i, args)) argss)
+        val flushes = List.concat
+                      o map (fn (i, argss) => map (fn args => flush (i, args)) argss)
         val doExp =
          fn EDml (origDmlText, failureMode) =>
             let
@@ -783,6 +783,18 @@ and typOfExp env (e', loc) = typOfExp' env e'
 (* Caching Pure Subexpressions *)
 (*******************************)
 
+val freeVars =
+    IS.listItems
+    o MonoUtil.Exp.foldB
+          {typ = #2,
+           exp = fn (bound, ERel n, vars) => if n < bound
+                                             then vars
+                                             else IS.add (vars, n - bound)
+                  | (_, _, vars) => vars,
+           bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound}
+          0
+          IS.empty
+
 datatype subexp = Pure of unit -> exp | Impure of exp
 
 val isImpure =
@@ -798,13 +810,14 @@ fun makeCache (env, exp', index) =
         NONE => NONE
       | SOME (TFun _, _) => NONE
       | SOME typ =>
-        case ListUtil.foldri (fn (_, _, NONE) => NONE
-                               | (n, typ, SOME args) =>
-                                 case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of
-                                     NONE => NONE
-                                   | SOME arg => SOME (arg :: args))
-                             (SOME [])
-                             (MonoEnv.typeContext env) of
+        case List.foldr (fn ((_, _), NONE) => NONE
+                          | ((n, typ), SOME args) =>
+                            case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of
+                                NONE => NONE
+                              | SOME arg => SOME (arg :: args))
+                        (SOME [])
+                        (map (fn n => (n, #2 (MonoEnv.lookupERel env n)))
+                             (freeVars (exp', dummyLoc))) of
             NONE => NONE
           | SOME args => cacheWrap (env, (exp', dummyLoc), typ, args, index)
 
@@ -906,7 +919,8 @@ fun addPure ((decls, sideInfo), index, effs) =
         val fmDecls = MonoFooify.getNewFmDecls ()
     in
         print (Int.toString (length fmDecls));
-        (decls @ fmDecls, sideInfo)
+        (* ASK: fmDecls before or after? *)
+        (fmDecls @ decls, sideInfo)
     end
 
 val go' = addPure o addFlushing o addChecking o inlineSql
-- 
cgit v1.2.3