summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Ziv Scully <ziv@mit.edu>2015-09-27 14:46:12 -0400
committerGravatar Ziv Scully <ziv@mit.edu>2015-09-27 14:46:12 -0400
commit067c8cd3b908eb057f6721453a5c3801965d43b8 (patch)
treef8bdebe6465d17dcf3ae8e2fbd745b9d66d35747 /src
parentf8d7c70d8f52003e14a66144a48bb4f06a1c185f (diff)
Use referenced (rather than all) free variables as keys for pure caches.
Diffstat (limited to 'src')
-rw-r--r--src/mono_env.sig2
-rw-r--r--src/mono_env.sml2
-rw-r--r--src/sqlcache.sml34
3 files changed, 24 insertions, 14 deletions
diff --git a/src/mono_env.sig b/src/mono_env.sig
index 9805c0d1..db6fdc95 100644
--- a/src/mono_env.sig
+++ b/src/mono_env.sig
@@ -42,8 +42,6 @@ signature MONO_ENV = sig
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 --git a/src/mono_env.sml b/src/mono_env.sml
index 8617425e..52e07893 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -108,8 +108,6 @@ fun lookupERel (env : env) n =
(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 --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