summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--compiler/main/StaticFlagParser.hs1
-rw-r--r--compiler/main/StaticFlags.hs5
-rw-r--r--compiler/simplCore/SimplUtils.lhs7
-rw-r--r--compiler/simplCore/Simplify.lhs45
-rw-r--r--docs/users_guide/flags.xml2
6 files changed, 34 insertions, 32 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b23bab1c41..35821b0114 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 45d37c7d0d..8397cce8bf 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 6330b2e872..69de53eb9d 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 54256498eb..9590288b22 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 df301421c0..55946cf34f 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 f2d34e3016..499c828d06 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>