Commit 51c4d029 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Allow inlining in "SimplGentle" mode

This change helps to break the mutual recursion generated by
an instance declaration.

See Note [Gentle mode] in SimplUtils
parent d2241e63
......@@ -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 })
......
......@@ -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) } ;
......
......@@ -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
......
......@@ -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.
......
......@@ -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]
......
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment