Mercurial > urweb

changeset 2257:28a541bd2d23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use referenced (rather than all) free variables as keys for pure caches.
author Ziv Scully <ziv@mit.edu>
date Sun, 27 Sep 2015 14:46:12 -0400
parents 6f2ea4ed573a
children b1ba35ce2613
files src/mono_env.sig src/mono_env.sml src/sqlcache.sml
diffstat 3 files changed, 24 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- 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
 
--- 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,
--- 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