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,
-- 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
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 })
import IdInfo
import CoreUtils ( coreBindsSize )
import Simplify ( simplTopBinds, simplExpr )
+import SimplUtils ( simplEnvForGHCi, simplEnvForRules )
import SimplEnv
import SimplMonad
import CoreMonad
-> 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"
; 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')
; return expr'
}
-gentleSimplEnv :: SimplEnv
-gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl [])
-
doCorePasses :: [CorePass] -> ModGuts -> CoreM ModGuts
doCorePasses passes guts = foldM (flip doCorePass) guts passes
; 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
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 })
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) } ;
\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,
inGentleMode :: SimplEnv -> Bool
inGentleMode env = case seMode env of
- SimplGently -> True
- _other -> False
+ SimplGently {} -> True
+ _other -> False
---------------------
getEnclosingCC :: SimplEnv -> CostCentreStack
-- Switch checker
SwitchChecker, SwitchResult(..), getSimplIntSwitch,
- isAmongSimpl, intSwitchSet, switchIsOn
+ isAmongSimpl, intSwitchSet, switchIsOn, allOffSwitchChecker
) where
import Id ( Id, mkSysLocal )
| 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.
-- Inlining,
preInlineUnconditionally, postInlineUnconditionally,
activeInline, activeRule,
+ simplEnvForGHCi, simplEnvForRules, simplGentlyForInlineRules,
-- The continuation type
SimplCont(..), DupFlag(..), ArgInfo(..),
%* *
%************************************************************************
-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
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 ...)...
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
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
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
= 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]
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
projects / ghc-hetmet.git / commitdiff