# HG changeset patch
# User Ziv Scully <ziv@mit.edu>
# Date 1443379572 14400
# Node ID 28a541bd2d235089247926e3a820c89194a94863
# Parent  6f2ea4ed573a29cd360edaa08d71528ad12fe845
Use referenced (rather than all) free variables as keys for pure caches.

diff -r 6f2ea4ed573a -r 28a541bd2d23 src/mono_env.sig
--- a/src/mono_env.sig	Sun Sep 27 03:52:14 2015 -0400
+++ b/src/mono_env.sig	Sun Sep 27 14:46:12 2015 -0400
@@ -42,8 +42,6 @@
     val pushERel : env -> string -> Mono.typ -> Mono.exp option -> env
     val lookupERel : env -> int -> string * Mono.typ * Mono.exp option
 
-    val typeContext : env -> Mono.typ list
-
     val pushENamed : env -> string -> int -> Mono.typ -> Mono.exp option -> string -> env
     val lookupENamed : env -> int -> string * Mono.typ * Mono.exp option * string
 
diff -r 6f2ea4ed573a -r 28a541bd2d23 src/mono_env.sml
--- a/src/mono_env.sml	Sun Sep 27 03:52:14 2015 -0400
+++ b/src/mono_env.sml	Sun Sep 27 14:46:12 2015 -0400
@@ -108,8 +108,6 @@
     (List.nth (#relE env, n))
     handle Subscript => raise UnboundRel n
 
-fun typeContext (env : env) = map #2 (#relE env)
-
 fun pushENamed (env : env) x n t eo s =
     {datatypes = #datatypes env,
      constructors = #constructors env,
diff -r 6f2ea4ed573a -r 28a541bd2d23 src/sqlcache.sml
--- a/src/sqlcache.sml	Sun Sep 27 03:52:14 2015 -0400
+++ b/src/sqlcache.sml	Sun Sep 27 14:46:12 2015 -0400
@@ -673,8 +673,8 @@
 
 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 @@
 (* 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 @@
         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 @@
         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