diff options
| -rw-r--r-- | src/mono_env.sig | 2 | ||||
| -rw-r--r-- | src/mono_env.sml | 2 | ||||
| -rw-r--r-- | src/sqlcache.sml | 34 |
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 |