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