[commit: ghc] master: Make -f(no-)pre-inlining a dynamic flag (e731cb1)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e731cb1330d818631373a041e2566b3590bf46ea

>---------------------------------------------------------------

commit e731cb1330d818631373a041e2566b3590bf46ea
Author: Ian Lynagh <[email protected]>
Date:   Tue Oct 9 23:28:13 2012 +0100

    Make -f(no-)pre-inlining a dynamic flag

>---------------------------------------------------------------

 compiler/main/DynFlags.hs         |    6 +++++
 compiler/main/StaticFlagParser.hs |    1 -
 compiler/main/StaticFlags.hs      |    5 ----
 compiler/simplCore/SimplUtils.lhs |    7 ++---
 compiler/simplCore/Simplify.lhs   |   45 +++++++++++++++++++-----------------
 docs/users_guide/flags.xml        |    2 +-
 6 files changed, 34 insertions(+), 32 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b23bab1..35821b0 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -341,6 +341,10 @@ data DynFlag
    | Opt_RelativeDynlibPaths
    | Opt_Hpc
 
+   -- PreInlining is on by default. The option is there just to see how
+   -- bad things get if you turn it off!
+   | Opt_SimplPreInlining
+
    -- output style opts
    | Opt_ErrorSpans -- Include full span info in error messages,
                     -- instead of just the start position.
@@ -2331,6 +2335,7 @@ fFlags = [
   ( "prof-count-entries",               Opt_ProfCountEntries, nop ),
   ( "prof-cafs",                        Opt_AutoSccsOnIndividualCafs, nop ),
   ( "hpc",                              Opt_Hpc, nop ),
+  ( "pre-inlining",                     Opt_SimplPreInlining, nop ),
   ( "use-rpaths",                       Opt_RPath, nop )
   ]
 
@@ -2512,6 +2517,7 @@ defaultFlags settings
       Opt_GhciHistory,
       Opt_HelpfulErrors,
       Opt_ProfCountEntries,
+      Opt_SimplPreInlining,
       Opt_RPath
     ]
 
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 45d37c7..8397cce 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -120,7 +120,6 @@ isStaticFlag f =
     "dno-black-holing",
     "fno-state-hack",
     "fruntime-types",
-    "fno-pre-inlining",
     "fno-opt-coercion",
     "fno-flat-cache",
     "fexcess-precision",
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 6330b2e..69de53e 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -35,7 +35,6 @@ module StaticFlags (
 	-- optimisation opts
 	opt_NoStateHack,
 	opt_CprOff,
-	opt_SimplNoPreInlining,
 	opt_SimplExcessPrecision,
 	opt_NoOptCoercion,
         opt_NoFlatCache,
@@ -179,10 +178,6 @@ opt_CprOff			= lookUp  (fsLit "-fcpr-off")
 	-- Switch off CPR analysis in the new demand analyser
 
 -- Simplifier switches
-opt_SimplNoPreInlining :: Bool
-opt_SimplNoPreInlining		= lookUp  (fsLit "-fno-pre-inlining")
-	-- NoPreInlining is there just to see how bad things
-	-- get if you don't do it!
 opt_SimplExcessPrecision :: Bool
 opt_SimplExcessPrecision	= lookUp  (fsLit "-fexcess-precision")
 
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 5425649..9590288 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -34,7 +34,6 @@ import SimplEnv
 import CoreMonad        ( SimplifierMode(..), Tick(..) )
 import MkCore           ( sortQuantVars )
 import DynFlags
-import StaticFlags
 import CoreSyn
 import qualified CoreSubst
 import PprCore
@@ -812,12 +811,12 @@ is a term (not a coercion) so we can't necessarily inline the latter in
 the former.
 
 \begin{code}
-preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
-preInlineUnconditionally env top_lvl bndr rhs
+preInlineUnconditionally :: DynFlags -> SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
+preInlineUnconditionally dflags env top_lvl bndr rhs
   | not active                               = False
   | isStableUnfolding (idUnfolding bndr)     = False -- Note [InlineRule and preInlineUnconditionally]
   | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids]
-  | opt_SimplNoPreInlining                   = False
+  | not (dopt Opt_SimplPreInlining dflags)   = False
   | isCoVar bndr                             = False -- Note [Do not inline CoVars unconditionally]
   | otherwise = case idOccInfo bndr of
                   IAmDead                    -> True -- Happens in ((\x.1) v)
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index df30142..55946cf 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -291,12 +291,12 @@ simplRecOrTopPair :: SimplEnv
                   -> SimplM SimplEnv    -- Returns an env that includes the binding
 
 simplRecOrTopPair env top_lvl is_rec old_bndr new_bndr rhs
-  | preInlineUnconditionally env top_lvl old_bndr rhs   -- Check for unconditional inline
-  = do  { tick (PreInlineUnconditionally old_bndr)
-        ; return (extendIdSubst env old_bndr (mkContEx env rhs)) }
-
-  | otherwise
-  = simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
+  = do dflags <- getDynFlags
+       -- Check for unconditional inline
+       if preInlineUnconditionally dflags env top_lvl old_bndr rhs
+           then do tick (PreInlineUnconditionally old_bndr)
+                   return (extendIdSubst env old_bndr (mkContEx env rhs))
+           else simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
 \end{code}
 
 
@@ -1333,21 +1333,24 @@ simplNonRecE env bndr (Type ty_arg, rhs_se) (bndrs, body) cont
         ; simplLam (extendTvSubst env bndr ty_arg') bndrs body cont }
 
 simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont
-  | preInlineUnconditionally env NotTopLevel bndr rhs
-  = do  { tick (PreInlineUnconditionally bndr)
-        ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
-          simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont }
-
-  | isStrictId bndr              -- Includes coercions
-  = do  { simplExprF (rhs_se `setFloats` env) rhs
-                     (StrictBind bndr bndrs body env cont) }
-
-  | otherwise
-  = ASSERT( not (isTyVar bndr) )
-    do  { (env1, bndr1) <- simplNonRecBndr env bndr
-        ; let (env2, bndr2) = addBndrRules env1 bndr bndr1
-        ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
-        ; simplLam env3 bndrs body cont }
+  = do dflags <- getDynFlags
+       case () of
+         _
+          | preInlineUnconditionally dflags env NotTopLevel bndr rhs ->
+            do  { tick (PreInlineUnconditionally bndr)
+                ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
+                  simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont }
+
+          | isStrictId bndr ->           -- Includes coercions
+            do  { simplExprF (rhs_se `setFloats` env) rhs
+                             (StrictBind bndr bndrs body env cont) }
+
+          | otherwise ->
+            ASSERT( not (isTyVar bndr) )
+            do  { (env1, bndr1) <- simplNonRecBndr env bndr
+                ; let (env2, bndr2) = addBndrRules env1 bndr bndr1
+                ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
+                ; simplLam env3 bndrs body cont }
 \end{code}
 
 %************************************************************************
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index f2d34e3..499c828 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1627,7 +1627,7 @@
           <row>
             <entry><option>-fno-pre-inlining</option></entry>
             <entry>Turn off pre-inlining</entry>
-            <entry>static</entry>
+            <entry>dynamic</entry>
             <entry>-</entry>
           </row>