From 51c4d029be44a5a629daf51b55cbca7cb734c172 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Mon, 9 Nov 2009 10:39:20 +0000 Subject: [PATCH] Allow inlining in "SimplGentle" mode This change helps to break the mutual recursion generated by an instance declaration. See Note [Gentle mode] in SimplUtils --- compiler/main/DynFlags.hs | 27 ++++++++---- compiler/simplCore/SimplCore.lhs | 13 +++--- compiler/simplCore/SimplEnv.lhs | 8 ++-- compiler/simplCore/SimplMonad.lhs | 5 ++- compiler/simplCore/SimplUtils.lhs | 82 ++++++++++++++++++++++++++++++------- compiler/simplCore/Simplify.lhs | 2 +- 6 files changed, 102 insertions(+), 35 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f0feb2f..53be2e9 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1004,18 +1004,27 @@ data CoreToDo -- These are diff core-to-core passes, data SimplifierMode -- See comments in SimplMonad = SimplGently - | SimplPhase Int [String] + { sm_rules :: Bool -- Whether RULES are enabled + , sm_inline :: Bool } -- Whether inlining is enabled -instance Outputable SimplifierMode where - ppr SimplGently = ptext (sLit "gentle") - ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss)) + | SimplPhase + { sm_num :: Int -- Phase number; counts downward so 0 is last phase + , sm_names :: [String] } -- Name(s) of the phase +instance Outputable SimplifierMode where + ppr (SimplPhase { sm_num = n, sm_names = ss }) + = int n <+> brackets (text (concat $ intersperse "," ss)) + ppr (SimplGently { sm_rules = r, sm_inline = i }) + = ptext (sLit "gentle") <> + brackets (pp_flag r (sLit "rules") <> comma <> + pp_flag i (sLit "inline")) + where + pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s data SimplifierSwitch = MaxSimplifierIterations Int | NoCaseOfCase - data FloatOutSwitches = FloatOutSwitches { floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level floatOutConstants :: Bool -- ^ True <=> float constants to top level, @@ -1103,7 +1112,9 @@ getCoreToDo dflags -- initial simplify: mk specialiser happy: minimum effort please - simpl_gently = CoreDoSimplify SimplGently [ + simpl_gently = CoreDoSimplify + (SimplGently { sm_rules = True, sm_inline = False }) + [ -- Simplify "gently" -- Don't inline anything till full laziness has bitten -- In particular, inlining wrappers inhibits floating @@ -2070,8 +2081,8 @@ setDumpSimplPhases s = do forceRecompile phase_num _ _ = False phase_name :: String -> SimplifierMode -> Bool - phase_name s SimplGently = s == "gentle" - phase_name s (SimplPhase _ ss) = s `elem` ss + phase_name s (SimplGently {}) = s == "gentle" + phase_name s (SimplPhase { sm_names = ss }) = s `elem` ss setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 0f881cf..df928f6 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -31,6 +31,7 @@ import OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) import IdInfo import CoreUtils ( coreBindsSize ) import Simplify ( simplTopBinds, simplExpr ) +import SimplUtils ( simplEnvForGHCi, simplEnvForRules ) import SimplEnv import SimplMonad import CoreMonad @@ -120,6 +121,8 @@ simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do -> IO CoreExpr -- simplifyExpr is called by the driver to simplify an -- expression typed in at the interactive prompt +-- +-- Also used by Template Haskell simplifyExpr dflags expr = do { ; Err.showPass dflags "Simplify" @@ -127,7 +130,7 @@ simplifyExpr dflags expr ; us <- mkSplitUniqSupply 's' ; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $ - simplExprGently gentleSimplEnv expr + simplExprGently simplEnvForGHCi expr ; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression" (pprCoreExpr expr') @@ -135,9 +138,6 @@ simplifyExpr dflags expr ; return expr' } -gentleSimplEnv :: SimplEnv -gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl []) - doCorePasses :: [CorePass] -> ModGuts -> CoreM ModGuts doCorePasses passes guts = foldM (flip doCorePass) guts passes @@ -333,7 +333,7 @@ prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt }) ; let -- Simplify the local rules; boringly, we need to make an in-scope set -- from the local binders, to avoid warnings from Simplify.simplVar local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds)) - env = setInScopeSet gentleSimplEnv local_ids + env = setInScopeSet simplEnvForRules local_ids (simpl_rules, _) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $ mapM (simplRule env) local_rules @@ -409,6 +409,7 @@ The simplifier does indeed do eta reduction (it's in Simplify.completeLam) but only if -O is on. \begin{code} +simplRule :: SimplEnv -> CoreRule -> SimplM CoreRule simplRule env rule@(BuiltinRule {}) = return rule simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) @@ -571,7 +572,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base eps <- hscEPS hsc_env ; let { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps) ; rule_base2 = extendRuleBaseList rule_base1 rules - ; simpl_env = mkSimplEnv mode sw_chkr + ; simpl_env = mkSimplEnv sw_chkr mode ; simpl_binds = {-# SCC "SimplTopBinds" #-} simplTopBinds simpl_env tagged_binds ; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ; diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index c10ad90..5d8b16c 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -206,8 +206,8 @@ seIdSubst: \begin{code} -mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv -mkSimplEnv mode switches +mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv +mkSimplEnv switches mode = SimplEnv { seChkr = switches, seCC = subsumedCCS, seMode = mode, seInScope = emptyInScopeSet, seFloats = emptyFloats, @@ -227,8 +227,8 @@ setMode mode env = env { seMode = mode } inGentleMode :: SimplEnv -> Bool inGentleMode env = case seMode env of - SimplGently -> True - _other -> False + SimplGently {} -> True + _other -> False --------------------- getEnclosingCC :: SimplEnv -> CostCentreStack diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 514fda6..39fb718 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -21,7 +21,7 @@ module SimplMonad ( -- Switch checker SwitchChecker, SwitchResult(..), getSimplIntSwitch, - isAmongSimpl, intSwitchSet, switchIsOn + isAmongSimpl, intSwitchSet, switchIsOn, allOffSwitchChecker ) where import Id ( Id, mkSysLocal ) @@ -419,6 +419,9 @@ data SwitchResult | SwString FastString -- nothing or a String | SwInt Int -- nothing or an Int +allOffSwitchChecker :: SwitchChecker +allOffSwitchChecker _ = SwBool False + isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult isAmongSimpl on_switches -- Switches mentioned later occur *earlier* -- in the list; defaults right at the end. diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index e0302a9..dfe9e83 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -11,6 +11,7 @@ module SimplUtils ( -- Inlining, preInlineUnconditionally, postInlineUnconditionally, activeInline, activeRule, + simplEnvForGHCi, simplEnvForRules, simplGentlyForInlineRules, -- The continuation type SimplCont(..), DupFlag(..), ArgInfo(..), @@ -410,9 +411,25 @@ interestingArgContext rules call_cont %* * %************************************************************************ -Inlining is controlled partly by the SimplifierMode switch. This has two -settings: +\begin{code} +simplEnvForGHCi :: SimplEnv +simplEnvForGHCi = mkSimplEnv allOffSwitchChecker $ + SimplGently { sm_rules = False, sm_inline = False } + -- Do not do any inlining, in case we expose some unboxed + -- tuple stuff that confuses the bytecode interpreter + +simplEnvForRules :: SimplEnv +simplEnvForRules = mkSimplEnv allOffSwitchChecker $ + SimplGently { sm_rules = True, sm_inline = False } + +simplGentlyForInlineRules :: SimplifierMode +simplGentlyForInlineRules = SimplGently { sm_rules = True, sm_inline = True } + -- Simplify as much as possible, subject to the usual "gentle" rules +\end{code} +Inlining is controlled partly by the SimplifierMode switch. This has two +settings + SimplGently (a) Simplifying before specialiser/full laziness (b) Simplifiying inside InlineRules (c) Simplifying the LHS of a rule @@ -421,7 +438,31 @@ settings: SimplPhase n _ Used at all other times -The key thing about SimplGently is that it does no call-site inlining. +Note [Gentle mode] +~~~~~~~~~~~~~~~~~~ +Gentle mode has a separate boolean flag to control + a) inlining (sm_inline flag) + b) rules (sm_rules flag) +A key invariant about Gentle mode is that it is treated as the EARLIEST +phase. Something is inlined if the sm_inline flag is on AND the thing +is inlinable in the earliest phase. This is important. Example + + {-# INLINE [~1] g #-} + g = ... + + {-# INLINE f #-} + f x = g (g x) + +If we were to inline g into f's inlining, then an importing module would +never be able to do + f e --> g (g e) ---> RULE fires +because the InlineRule for f has had g inlined into it. + +On the other hand, it is bad not to do ANY inlining into an +InlineRule, because then recursive knots in instance declarations +don't get unravelled. + +However, *sometimes* SimplGently must do no call-site inlining at all. Before full laziness we must be careful not to inline wrappers, because doing so inhibits floating e.g. ...(case f x of ...)... @@ -547,6 +588,18 @@ seems a bit fragile. Conclusion: inline top level things gaily until Phase 0 (the last phase), at which point don't. +Note [pre/postInlineUnconditionally in gentle mode] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Even in gentle mode we want to do preInlineUnconditionally. The +reason is that too little clean-up happens if you don't inline +use-once things. Also a bit of inlining is *good* for full laziness; +it can expose constant sub-expressions. Example in +spectral/mandel/Mandel.hs, where the mandelset function gets a useful +let-float if you inline windowToViewport + +However, as usual for Gentle mode, do not inline things that are +inactive in the intial stages. See Note [Gentle mode]. + \begin{code} preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool preInlineUnconditionally env top_lvl bndr rhs @@ -559,7 +612,8 @@ preInlineUnconditionally env top_lvl bndr rhs where phase = getMode env active = case phase of - SimplGently -> isEarlyActive act + SimplGently {} -> isEarlyActive act + -- See Note [pre/postInlineUnconditionally in gentle mode] SimplPhase n _ -> isActive n act act = idInlineActivation bndr @@ -716,21 +770,17 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding where active = case getMode env of - SimplGently -> isAlwaysActive act + SimplGently {} -> isEarlyActive act + -- See Note [pre/postInlineUnconditionally in gentle mode] SimplPhase n _ -> isActive n act act = idInlineActivation bndr activeInline :: SimplEnv -> OutId -> Bool activeInline env id = case getMode env of - SimplGently -> False - -- No inlining at all when doing gentle stuff, - -- except for local things that occur once (pre/postInlineUnconditionally) - -- The reason is that too little clean-up happens if you - -- don't inline use-once things. Also a bit of inlining is *good* for - -- full laziness; it can expose constant sub-expressions. - -- Example in spectral/mandel/Mandel.hs, where the mandelset - -- function gets a useful let-float if you inline windowToViewport + SimplGently { sm_inline = inlining_on } + -> inlining_on && isEarlyActive act + -- See Note [Gentle mode] -- NB: we used to have a second exception, for data con wrappers. -- On the grounds that we use gentle mode for rule LHSs, and @@ -750,13 +800,15 @@ activeRule dflags env = Nothing -- Rewriting is off | otherwise = case getMode env of - SimplGently -> Just isAlwaysActive + SimplGently { sm_rules = rules_on } + | rules_on -> Just isEarlyActive + | otherwise -> Nothing -- Used to be Nothing (no rules in gentle mode) -- Main motivation for changing is that I wanted -- lift String ===> ... -- to work in Template Haskell when simplifying -- splices, so we get simpler code for literal strings - SimplPhase n _ -> Just (isActive n) + SimplPhase n _ -> Just (isActive n) \end{code} Note [InlineRule and postInlineUnconditionally] diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 6a579db..d847d3b 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -654,7 +654,7 @@ simplUnfolding env _ _ _ _ (DFunUnfolding con ops) simplUnfolding env top_lvl _ _ _ (CoreUnfolding { uf_tmpl = expr, uf_arity = arity , uf_guidance = guide@(InlineRule {}) }) - = do { expr' <- simplExpr (setMode SimplGently env) expr + = do { expr' <- simplExpr (setMode simplGentlyForInlineRules env) expr -- See Note [Simplifying gently inside InlineRules] in SimplUtils ; let mb_wkr' = CoreSubst.substInlineRuleInfo (mkCoreSubst env) (ir_info guide) ; return (mkCoreUnfolding (isTopLevel top_lvl) expr' arity -- 1.7.10.4