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> _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
