\begin{code}
module SimplUtils (
-- Rebuilding
- mkLam, mkCase, prepareAlts,
+ mkLam, mkCase, prepareAlts, tryEtaExpand,
-- Inlining,
preInlineUnconditionally, postInlineUnconditionally,
import CoreUnfold
import Name
import Id
-import Var ( Var, isCoVar )
+import Var
import Demand
import SimplMonad
import Type hiding( substTy )
\end{code}
-
%************************************************************************
%* *
-\subsection{Decisions about inlining}
+ Gentle mode
%* *
%************************************************************************
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
+phase.
+
+\begin{code}
+simplEnvForGHCi :: SimplEnv
+simplEnvForGHCi = mkSimplEnv allOffSwitchChecker $
+ SimplGently { sm_rules = True, 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 }
+
+updModeForInlineRules :: Activation -> SimplifierMode -> SimplifierMode
+-- See Note [Simplifying inside InlineRules]
+updModeForInlineRules _inline_rule_act _current_mode
+ = SimplGently { sm_rules = True, sm_inline = True }
+\end{code}
+
+Note [Inlining in gentle mode]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Something is inlined if
+ (i) the sm_inline flag is on, AND
+ (ii) the thing has an INLINE pragma, AND
+ (iii) the thing is inlinable in the earliest phase.
+
+Example of why (iii) is important:
{-# INLINE [~1] g #-}
g = ...
But watch out: list fusion can prevent floating. So use phase control
to switch off those rules until after floating.
+Currently (Oct10) I think that sm_rules is always True, so we
+could remove it.
+
Note [Simplifying inside InlineRules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must take care with simplification inside InlineRules (which come from
Second, we do want *do* to some modest rules/inlining stuff in InlineRules,
partly to eliminate senseless crap, and partly to break the recursive knots
generated by instance declarations. To keep things simple, we always set
-the phase to 'gentle' when processing InlineRules. OK, so suppose we have
- {-# INLINE <act> f #-}
- f = <rhs>
-meaning "inline f in phases p where activation <act>(p) holds".
-Then what inlinings/rules can we apply to the copy of <rhs> captured in
-f's InlineRule? Our model is that literally <rhs> is substituted for
-f when it is inlined. So our conservative plan (implemented by
-updModeForInlineRules) is this:
-
- -------------------------------------------------------------
- When simplifying the RHS of an InlineRule,
- If the InlineRule becomes active in phase p, then
- if the current phase is *earlier than* p,
- make no inlinings or rules active when simplifying the RHS
- otherwise
- set the phase to p when simplifying the RHS
- -------------------------------------------------------------
-
-That ensures that
-
- a) Rules/inlinings that *cease* being active before p will
- not apply to the InlineRule rhs, consistent with it being
- inlined in its *original* form in phase p.
-
- b) Rules/inlinings that only become active *after* p will
- not apply to the InlineRule rhs, again to be consistent with
- inlining the *original* rhs in phase p.
-
-For example,
- {-# INLINE f #-}
- f x = ...g...
-
- {-# NOINLINE [1] g #-}
- g y = ...
-
- {-# RULE h g = ... #-}
-Here we must not inline g into f's RHS, even when we get to phase 0,
-because when f is later inlined into some other module we want the
-rule for h to fire.
-
-Similarly, consider
- {-# INLINE f #-}
- f x = ...g...
-
- g y = ...
-and suppose that there are auto-generated specialisations and a strictness
-wrapper for g. The specialisations get activation AlwaysActive, and the
-strictness wrapper get activation (ActiveAfter 0). So the strictness
-wrepper fails the test and won't be inlined into f's InlineRule. That
-means f can inline, expose the specialised call to g, so the specialisation
-rules can fire.
+the phase to 'gentle' when processing InlineRules.
A note about wrappers
~~~~~~~~~~~~~~~~~~~~~
continuation.
\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
+activeUnfolding :: SimplEnv -> IdUnfoldingFun
+activeUnfolding env
+ = case getMode env of
+ SimplGently { sm_inline = False } -> active_unfolding_minimal
+ SimplGently { sm_inline = True } -> active_unfolding_gentle
+ SimplPhase n _ -> active_unfolding n
-simplEnvForRules :: SimplEnv
-simplEnvForRules = mkSimplEnv allOffSwitchChecker $
- SimplGently { sm_rules = True, sm_inline = False }
+activeUnfInRule :: SimplEnv -> IdUnfoldingFun
+-- When matching in RULE, we want to "look through" an unfolding
+-- (to see a constructor) if *rules* are on, even if *inlinings*
+-- are not. A notable example is DFuns, which really we want to
+-- match in rules like (op dfun) in gentle mode. Another example
+-- is 'otherwise' which we want exprIsConApp_maybe to be able to
+-- see very early on
+activeUnfInRule env
+ = case getMode env of
+ SimplGently { sm_rules = False } -> active_unfolding_minimal
+ SimplGently { sm_rules = True } -> active_unfolding_early
+ SimplPhase n _ -> active_unfolding n
+ where
+ active_unfolding_early id
+ | isEarlyActive (idInlineActivation id) = idUnfolding id
+ | otherwise = idUnfolding id
-updModeForInlineRules :: Activation -> SimplifierMode -> SimplifierMode
--- See Note [Simplifying inside InlineRules]
--- Treat Gentle as phase "infinity"
--- If current_phase `earlier than` inline_rule_start_phase
--- then no_op
--- else
--- if current_phase `same phase` inline_rule_start_phase
--- then current_phase (keep gentle flags)
--- else inline_rule_start_phase
-updModeForInlineRules inline_rule_act current_mode
- = case inline_rule_act of
- NeverActive -> no_op
- AlwaysActive -> mk_gentle current_mode
- ActiveBefore {} -> mk_gentle current_mode
- ActiveAfter n -> mk_phase n current_mode
+active_unfolding_minimal :: IdUnfoldingFun
+-- Compuslory unfoldings only
+-- Ignore SimplGently, because we want to inline regardless;
+-- the Id has no top-level binding at all
+--
+-- NB: we used to have a second exception, for data con wrappers.
+-- On the grounds that we use gentle mode for rule LHSs, and
+-- they match better when data con wrappers are inlined.
+-- But that only really applies to the trivial wrappers (like (:)),
+-- and they are now constructed as Compulsory unfoldings (in MkId)
+-- so they'll happen anyway.
+active_unfolding_minimal id
+ | isCompulsoryUnfolding unf = unf
+ | otherwise = NoUnfolding
where
- no_op = SimplGently { sm_rules = False, sm_inline = False }
+ unf = idUnfolding id
- mk_gentle (SimplGently {}) = current_mode
- mk_gentle _ = SimplGently { sm_rules = True, sm_inline = True }
+active_unfolding_gentle :: IdUnfoldingFun
+-- Anything that is early-active
+-- See Note [Gentle mode]
+active_unfolding_gentle id
+ | isStableUnfolding unf
+ , isEarlyActive (idInlineActivation id) = unf
+ -- NB: wrappers are not early-active
+ | otherwise = NoUnfolding
+ where
+ unf = idUnfolding id
+ -- idUnfolding checks for loop-breakers
+ -- Things with an INLINE pragma may have
+ -- an unfolding *and* be a loop breaker
+ -- (maybe the knot is not yet untied)
+
+active_unfolding :: CompilerPhase -> IdUnfoldingFun
+active_unfolding n id
+ | isActive n (idInlineActivation id) = idUnfolding id
+ | otherwise = NoUnfolding
- mk_phase n (SimplPhase _ ss) = SimplPhase n ss
- mk_phase n (SimplGently {}) = SimplPhase n ["gentle-rules"]
+activeRule :: DynFlags -> SimplEnv -> Maybe (Activation -> Bool)
+-- Nothing => No rules at all
+activeRule dflags env
+ | not (dopt Opt_EnableRewriteRules dflags)
+ = Nothing -- Rewriting is off
+ | otherwise
+ = case getMode env of
+ SimplGently { sm_rules = rules_on }
+ | rules_on -> Just isEarlyActive -- Note [RULEs enabled in SimplGently]
+ | otherwise -> Nothing
+ SimplPhase n _ -> Just (isActive n)
\end{code}
+--------------------------------------------------------------
+ OLD NOTES, now wrong
+ Preserved just for now (Oct 10)
+--------------------------------------------------------------
+
+ OK, so suppose we have
+ {-# INLINE <act> f #-}
+ f = <rhs>
+ meaning "inline f in phases p where activation <act>(p) holds".
+ Then what inlinings/rules can we apply to the copy of <rhs> captured in
+ f's InlineRule? Our model is that literally <rhs> is substituted for
+ f when it is inlined. So our conservative plan (implemented by
+ updModeForInlineRules) is this:
+
+ -------------------------------------------------------------
+ When simplifying the RHS of an InlineRule,
+ If the InlineRule becomes active in phase p, then
+ if the current phase is *earlier than* p,
+ make no inlinings or rules active when simplifying the RHS
+ otherwise
+ set the phase to p when simplifying the RHS
+
+ -- Treat Gentle as phase "infinity"
+ -- If current_phase `earlier than` inline_rule_start_phase
+ -- then no_op
+ -- else
+ -- if current_phase `same phase` inline_rule_start_phase
+ -- then current_phase (keep gentle flags)
+ -- else inline_rule_start_phase
+ -------------------------------------------------------------
+
+ That ensures that
+
+ a) Rules/inlinings that *cease* being active before p will
+ not apply to the InlineRule rhs, consistent with it being
+ inlined in its *original* form in phase p.
+
+ b) Rules/inlinings that only become active *after* p will
+ not apply to the InlineRule rhs, again to be consistent with
+ inlining the *original* rhs in phase p.
+
+ For example,
+ {-# INLINE f #-}
+ f x = ...g...
+
+ {-# NOINLINE [1] g #-}
+ g y = ...
+
+ {-# RULE h g = ... #-}
+ Here we must not inline g into f's RHS, even when we get to phase 0,
+ because when f is later inlined into some other module we want the
+ rule for h to fire.
+
+ Similarly, consider
+ {-# INLINE f #-}
+ f x = ...g...
+
+ g y = ...
+ and suppose that there are auto-generated specialisations and a strictness
+ wrapper for g. The specialisations get activation AlwaysActive, and the
+ strictness wrapper get activation (ActiveAfter 0). So the strictness
+ wrepper fails the test and won't be inlined into f's InlineRule. That
+ means f can inline, expose the specialised call to g, so the specialisation
+ rules can fire.
+
+--------------------------------------------------------------
+ END OF OLD NOTES
+--------------------------------------------------------------
+
+
+%************************************************************************
+%* *
+ preInlineUnconditionally
+%* *
+%************************************************************************
preInlineUnconditionally
~~~~~~~~~~~~~~~~~~~~~~~~
\end{code}
+%************************************************************************
+%* *
+ postInlineUnconditionally
+%* *
+%************************************************************************
+
postInlineUnconditionally
~~~~~~~~~~~~~~~~~~~~~~~~~
@postInlineUnconditionally@ decides whether to unconditionally inline
-- See Note [pre/postInlineUnconditionally in gentle mode]
SimplPhase n _ -> isActive n act
act = idInlineActivation bndr
-
-activeUnfolding :: SimplEnv -> IdUnfoldingFun
-activeUnfolding env
- = case getMode env of
- SimplGently { sm_inline = False } -> active_unfolding_minimal
- SimplGently { sm_inline = True } -> active_unfolding_gentle
- SimplPhase n _ -> active_unfolding n
-
-activeUnfInRule :: SimplEnv -> IdUnfoldingFun
--- When matching in RULE, we want to "look through" an unfolding
--- if *rules* are on, even if *inlinings* are not. A notable example
--- is DFuns, which really we want to match in rules like (op dfun)
--- in gentle mode.
-activeUnfInRule env
- = case getMode env of
- SimplGently { sm_rules = False } -> active_unfolding_minimal
- SimplGently { sm_rules = True } -> active_unfolding_gentle
- SimplPhase n _ -> active_unfolding n
-
-active_unfolding_minimal :: IdUnfoldingFun
--- Compuslory unfoldings only
--- Ignore SimplGently, because we want to inline regardless;
--- the Id has no top-level binding at all
---
--- NB: we used to have a second exception, for data con wrappers.
--- On the grounds that we use gentle mode for rule LHSs, and
--- they match better when data con wrappers are inlined.
--- But that only really applies to the trivial wrappers (like (:)),
--- and they are now constructed as Compulsory unfoldings (in MkId)
--- so they'll happen anyway.
-active_unfolding_minimal id
- | isCompulsoryUnfolding unf = unf
- | otherwise = NoUnfolding
- where
- unf = realIdUnfolding id -- Never a loop breaker
-
-active_unfolding_gentle :: IdUnfoldingFun
--- Anything that is early-active
--- See Note [Gentle mode]
-active_unfolding_gentle id
- | isEarlyActive (idInlineActivation id) = idUnfolding id
- | otherwise = NoUnfolding
- -- idUnfolding checks for loop-breakers
- -- Things with an INLINE pragma may have
- -- an unfolding *and* be a loop breaker
- -- (maybe the knot is not yet untied)
-
-active_unfolding :: CompilerPhase -> IdUnfoldingFun
-active_unfolding n id
- | isActive n (idInlineActivation id) = idUnfolding id
- | otherwise = NoUnfolding
-
-activeRule :: DynFlags -> SimplEnv -> Maybe (Activation -> Bool)
--- Nothing => No rules at all
-activeRule dflags env
- | not (dopt Opt_EnableRewriteRules dflags)
- = Nothing -- Rewriting is off
- | otherwise
- = case getMode env of
- SimplGently { sm_rules = rules_on }
- | rules_on -> Just isEarlyActive -- Note [RULEs enabled in SimplGently]
- | otherwise -> Nothing
- SimplPhase n _ -> Just (isActive n)
\end{code}
Note [Top level and postInlineUnconditionally]
= do { tick (EtaReduction (head bndrs))
; return etad_lam }
- | dopt Opt_DoLambdaEtaExpansion dflags
- , any ok_to_expand bndrs
- = do { let body' = etaExpand fun_arity body
- fun_arity = exprEtaExpandArity dflags body
- ; return (mkLams bndrs body') }
-
| otherwise
= return (mkLams bndrs body)
-
- ok_to_expand :: Var -> Bool -- Note [When to eta expand]
- ok_to_expand bndr = isId bndr && not (isDictId bndr)
\end{code}
-Note [When to eta expand]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-We only eta expand if there is at least one non-tyvar, non-dict
-binder. The proximate cause for not eta-expanding dictionary lambdas
-was this example:
- genMap :: C a => ...
- {-# INLINE genMap #-}
- genMap f xs = ...
-
- myMap :: D a => ...
- {-# INLINE myMap #-}
- myMap = genMap
-
-Notice that 'genMap' should only inline if applied to two arguments.
-In the InlineRule for myMap we'll have the unfolding
- (\d -> genMap Int (..d..))
-We do not want to eta-expand to
- (\d f xs -> genMap Int (..d..) f xs)
-because then 'genMap' will inline, and it really shouldn't: at least
-as far as the programmer is concerned, it's not applied to two
-arguments!
Note [Casts and lambdas]
~~~~~~~~~~~~~~~~~~~~~~~~
/\g. e `cast` g ==> (/\g.e) `cast` (/\g.g)
because the latter is not well-kinded.
--- c) floating lets out through big lambdas
--- [only if all tyvar lambdas, and only if this lambda
--- is the RHS of a let]
-
-{- Sept 01: I'm experimenting with getting the
- full laziness pass to float out past big lambdsa
- | all isTyCoVar bndrs, -- Only for big lambdas
- contIsRhs cont -- Only try the rhs type-lambda floating
- -- if this is indeed a right-hand side; otherwise
- -- we end up floating the thing out, only for float-in
- -- to float it right back in again!
- = do (floats, body') <- tryRhsTyLam env bndrs body
- return (floats, mkLams bndrs body')
--}
+%************************************************************************
+%* *
+ Eta expansion
+%* *
+%************************************************************************
+
+\begin{code}
+tryEtaExpand :: SimplEnv -> OutId -> OutExpr -> SimplM (Arity, OutExpr)
+-- See Note [Eta-expanding at let bindings]
+tryEtaExpand env bndr rhs
+ = do { dflags <- getDOptsSmpl
+ ; (new_arity, new_rhs) <- try_expand dflags
+
+ ; WARN( new_arity < old_arity || new_arity < _dmd_arity,
+ (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_arity
+ <+> ppr new_arity <+> ppr _dmd_arity) $$ ppr new_rhs) )
+ -- Note [Arity decrease]
+ return (new_arity, new_rhs) }
+ where
+ try_expand dflags
+ | dopt Opt_DoLambdaEtaExpansion dflags
+ , not (exprIsTrivial rhs)
+ , not (inGentleMode env) -- In gentle mode don't eta-expansion
+ -- because it can clutter up the code
+ -- with casts etc that may not be removed
+ , let new_arity = exprEtaExpandArity dflags rhs
+ , new_arity > old_arity
+ = do { tick (EtaExpansion bndr)
+ ; return (new_arity, etaExpand new_arity rhs) }
+ | otherwise
+ = return (exprArity rhs, rhs)
+
+ old_arity = idArity bndr
+ _dmd_arity = length $ fst $ splitStrictSig $ idStrictness bndr
+\end{code}
+
+Note [Eta-expanding at let bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We now eta expand at let-bindings, which is where the payoff
+comes.
+
+One useful consequence is this example:
+ genMap :: C a => ...
+ {-# INLINE genMap #-}
+ genMap f xs = ...
+
+ myMap :: D a => ...
+ {-# INLINE myMap #-}
+ myMap = genMap
+
+Notice that 'genMap' should only inline if applied to two arguments.
+In the InlineRule for myMap we'll have the unfolding
+ (\d -> genMap Int (..d..))
+We do not want to eta-expand to
+ (\d f xs -> genMap Int (..d..) f xs)
+because then 'genMap' will inline, and it really shouldn't: at least
+as far as the programmer is concerned, it's not applied to two
+arguments!
+
%************************************************************************
%* *
projects / ghc-hetmet.git / blobdiff