Mercurial > urweb
changeset 1820:3c56aa6a0f55
Reduce default inlining thresholds; improve a let-substitution optimization to compensate
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Fri, 14 Sep 2012 07:35:48 -0400 |
| parents | c9c38157d0d3 |
| children | e8149592990e |
| files | src/mono_reduce.sml src/settings.sml |
| diffstat | 2 files changed, 26 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/src/mono_reduce.sml Fri Sep 14 06:44:14 2012 -0400 +++ b/src/mono_reduce.sml Fri Sep 14 07:35:48 2012 -0400 @@ -313,10 +313,28 @@ val (timpures, impures, absCounts) = foldl (fn ((d, _), (timpures, impures, absCounts)) => let - fun countAbs (e, _) = - case e of - EAbs (_, _, _, e) => 1 + countAbs e - | _ => 0 + fun countAbs env e = + case #1 e of + EAbs (x, t, _, e) => 1 + countAbs (E.pushERel env x t NONE) e + | _ => + let + fun remaining e = + case #1 e of + ENamed n => IM.find (absCounts, n) + | EApp (e, arg) => + if simpleImpure (timpures, impures) env arg then + NONE + else + (case remaining e of + NONE => NONE + | SOME n => if n > 0 then + SOME (n - 1) + else + NONE) + | _ => NONE + in + getOpt (remaining e, 0) + end in case d of DDatatype dts => @@ -335,7 +353,7 @@ IS.add (impures, n) else impures, - IM.insert (absCounts, n, countAbs e)) + IM.insert (absCounts, n, countAbs E.empty e)) | DValRec vis => (timpures, if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then @@ -344,7 +362,7 @@ else impures, foldl (fn ((x, n, _, e, _), absCounts) => - IM.insert (absCounts, n, countAbs e)) + IM.insert (absCounts, n, countAbs E.empty e)) absCounts vis) | _ => (timpures, impures, absCounts) end)
--- a/src/settings.sml Fri Sep 14 06:44:14 2012 -0400 +++ b/src/settings.sml Fri Sep 14 07:35:48 2012 -0400 @@ -615,11 +615,11 @@ fun setSql so = sql := so fun getSql () = !sql -val coreInline = ref 20 +val coreInline = ref 5 fun setCoreInline n = coreInline := n fun getCoreInline () = !coreInline -val monoInline = ref 100 +val monoInline = ref 5 fun setMonoInline n = monoInline := n fun getMonoInline () = !monoInline