import CoreUtils ( exprIsTrivial, isDefaultAlt )
import Coercion ( mkSymCoercion )
import Id
-import IdInfo
import BasicTypes
import VarSet
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We avoid infinite inlinings by choosing loop breakers, and
ensuring that a loop breaker cuts each loop. But what is a
- "loop"? In particular, a RULES is like an equation for 'f' that
- is *always* inlined if it are applicable. We do *not* disable
+ "loop"? In particular, a RULE is like an equation for 'f' that
+ is *always* inlined if it is applicable. We do *not* disable
rules for loop-breakers. It's up to whoever makes the rules to
make sure that the rules themselves alwasys terminate. See Note
[Rules for recursive functions] in Simplify.lhs
* Note [Rule dependency info]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
The VarSet in a SpecInfo is used for dependency analysis in the
- occurrence analyser. We must track free vars in *both* lhs and rhs. Why both?
- Consider
+ occurrence analyser. We must track free vars in *both* lhs and rhs.
+ Hence use of idRuleVars, rather than idRuleRhsVars in addRuleUsage.
+ Why both? Consider
x = y
RULE f x = 4
Then if we substitute y for x, we'd better do so in the
where
new_fvs = extendFvs env emptyVarSet fvs
-idRuleRhsVars :: Id -> VarSet
--- Just the variables free on the *rhs* of a rule
--- See Note [Choosing loop breakers]
-idRuleRhsVars id = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet (idCoreRules id)
-
extendFvs :: IdEnv IdSet -> IdSet -> IdSet -> IdSet
-- (extendFVs env fvs s) returns (fvs `union` env(s))
extendFvs env fvs id_set
score :: Node Details -> Int -- Higher score => less likely to be picked as loop breaker
score (ND bndr rhs _ _, _, _)
- | workerExists (idWorkerInfo bndr) = 10
- -- Note [Worker inline loop]
+ | isInlineRule (idUnfolding bndr) = 10
+ -- Note [INLINE pragmas]
| exprIsTrivial rhs = 5 -- Practically certain to be inlined
-- Used to have also: && not (isExportedId bndr)
-- bad choice for loop breaker
| is_con_app rhs = 3 -- Data types help with cases
- -- Note [conapp]
+ -- Note [Constructor applictions]
-- If an Id is marked "never inline" then it makes a great loop breaker
-- The only reason for not checking that here is that it is rare
-- so it probably isn't worth the time to test on every binder
-- | isNeverActive (idInlinePragma bndr) = -10
- | inlineCandidate bndr rhs = 2 -- Likely to be inlined
- -- Note [Inline candidates]
+ | isOneOcc (idOccInfo bndr) = 1 -- Likely to be inlined
- | not (neverUnfold (idUnfolding bndr)) = 1
+ | canUnfold (idUnfolding bndr) = 1
-- the Id has some kind of unfolding
| otherwise = 0
- inlineCandidate :: Id -> CoreExpr -> Bool
- inlineCandidate _ (Note InlineMe _) = True
- inlineCandidate id _ = isOneOcc (idOccInfo id)
-
- -- Note [conapp]
- --
- -- It's really really important to inline dictionaries. Real
- -- example (the Enum Ordering instance from GHC.Base):
- --
- -- rec f = \ x -> case d of (p,q,r) -> p x
- -- g = \ x -> case d of (p,q,r) -> q x
- -- d = (v, f, g)
- --
- -- Here, f and g occur just once; but we can't inline them into d.
- -- On the other hand we *could* simplify those case expressions if
- -- we didn't stupidly choose d as the loop breaker.
- -- But we won't because constructor args are marked "Many".
- -- Inlining dictionaries is really essential to unravelling
- -- the loops in static numeric dictionaries, see GHC.Float.
-
+ -- Checking for a constructor application
-- Cheap and cheerful; the simplifer moves casts out of the way
-- The lambda case is important to spot x = /\a. C (f a)
-- which comes up when C is a dictionary constructor and
is_con_app _ = False
makeLoopBreaker :: Bool -> Id -> Id
--- Set the loop-breaker flag
--- See Note [Weak loop breakers]
+-- Set the loop-breaker flag: see Note [Weak loop breakers]
makeLoopBreaker weak bndr = setIdOccInfo bndr (IAmALoopBreaker weak)
\end{code}
-Note [Worker inline loop]
-~~~~~~~~~~~~~~~~~~~~~~~~
-Never choose a wrapper as the loop breaker! Because
-wrappers get auto-generated inlinings when importing, and
-that can lead to an infinite inlining loop. For example:
+Note [INLINE pragmas]
+~~~~~~~~~~~~~~~~~~~~~
+Never choose a function with an INLINE pramga as the loop breaker!
+If such a function is mutually-recursive with a non-INLINE thing,
+then the latter should be the loop-breaker.
+
+A particular case is wrappers generated by the demand analyser.
+If you make then into a loop breaker you may get an infinite
+inlining loop. For example:
rec {
$wfoo x = ....foo x....
{-loop brk-} foo x = ...$wfoo x...
}
-
The interface file sees the unfolding for $wfoo, and sees that foo is
strict (and hence it gets an auto-generated wrapper). Result: an
infinite inlining in the importing scope. So be a bit careful if you
breaker then compiling Game.hs goes into an infinite loop (this
happened when we gave is_con_app a lower score than inline candidates).
+Note [Constructor applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's really really important to inline dictionaries. Real
+example (the Enum Ordering instance from GHC.Base):
+
+ rec f = \ x -> case d of (p,q,r) -> p x
+ g = \ x -> case d of (p,q,r) -> q x
+ d = (v, f, g)
+
+Here, f and g occur just once; but we can't inline them into d.
+On the other hand we *could* simplify those case expressions if
+we didn't stupidly choose d as the loop breaker.
+But we won't because constructor args are marked "Many".
+Inlining dictionaries is really essential to unravelling
+the loops in static numeric dictionaries, see GHC.Float.
+
Note [Closure conversion]
~~~~~~~~~~~~~~~~~~~~~~~~~
We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
= occAnal ctxt rhs
where
ctxt | certainly_inline id = env
- | otherwise = rhsCtxt
+ | otherwise = rhsCtxt env
-- Note that we generally use an rhsCtxt. This tells the occ anal n
-- that it's looking at an RHS, which has an effect in occAnalApp
--
-- Add the usage from RULES in Id to the usage
addRuleUsage usage id
= foldVarSet add usage (idRuleVars id)
+ -- idRuleVars here: see Note [Rule dependency info]
where
- add v u = addOneOcc u v NoOccInfo -- Give a non-committal binder info
- -- (i.e manyOcc) because many copies
- -- of the specialised thing can appear
+ add v u = addOneOcc u v NoOccInfo
+ -- Give a non-committal binder info (i.e manyOcc) because
+ -- a) Many copies of the specialised thing can appear
+ -- b) We don't want to substitute a BIG expression inside a RULE
+ -- even if that's the only occurrence of the thing
+ -- (Same goes for INLINE.)
\end{code}
Expressions
\end{code}
\begin{code}
-occAnal env (Note InlineMe body)
- = case occAnal env body of { (usage, body') ->
- (mapVarEnv markMany usage, Note InlineMe body')
- }
-
occAnal env (Note note@(SCC _) body)
= case occAnal env body of { (usage, body') ->
(mapVarEnv markInsideSCC usage, Note note body')
(really_final_usage,
mkLams tagged_binders body') }
where
- env_body = vanillaCtxt -- Body is (no longer) an RhsContext
+ env_body = vanillaCtxt env -- Body is (no longer) an RhsContext
(binders, body) = collectBinders expr
binders' = oneShotGroup env binders
linear = all is_one_shot binders'
Nothing -> usage
Just _ -> extendVarEnv usage bndr NoOccInfo
- alt_env = setVanillaCtxt env
+ alt_env = mkAltEnv env bndr_swap
-- Consider x = case v of { True -> (p,q); ... }
-- Then it's fine to inline p and q
-- in an interesting context; the case has
-- at least one non-default alternative
occ_anal_scrut scrut _alts
- = occAnal vanillaCtxt scrut -- No need for rhsCtxt
+ = occAnal (vanillaCtxt env) scrut -- No need for rhsCtxt
occAnal env (Let bind body)
= case occAnal env body of { (body_usage, body') ->
(final_usage, mkLets new_binds body') }}
occAnalArgs :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr])
-occAnalArgs _env args
+occAnalArgs env args
= case mapAndUnzip (occAnal arg_env) args of { (arg_uds_s, args') ->
(foldr (+++) emptyDetails arg_uds_s, args')}
where
- arg_env = vanillaCtxt
+ arg_env = vanillaCtxt env
\end{code}
Applications are dealt with specially because we want
appSpecial env n ctxt args
= go n args
where
- arg_env = vanillaCtxt
+ arg_env = vanillaCtxt env
go _ [] = (emptyDetails, []) -- Too few args
go 1 (arg:args) -- The magic arg
- = case occAnal (setCtxt arg_env ctxt) arg of { (arg_uds, arg') ->
+ = case occAnal (setCtxtTy arg_env ctxt) arg of { (arg_uds, arg') ->
case occAnalArgs env args of { (args_uds, args') ->
(arg_uds +++ args_uds, arg':args') }}
==>
case (x |> co) of b { pi -> let x = b |> sym co in ri }
- Why (2)? See Note [Ccase of cast]
+ Why (2)? See Note [Case of cast]
In both cases, in a particular alternative (pi -> ri), we only
add the binding if
(a) x occurs free in (pi -> ri)
(ie it occurs in ri, but is not bound in pi)
(b) the pi does not bind b (or the free vars of co)
- (c) x is not a
We need (a) and (b) for the inserted binding to be correct.
-Notice that (a) rapidly becomes false, so no bindings are injected.
-
-Notice the deliberate shadowing of 'x'. But we must call localiseId
-on 'x' first, in case it's a GlobalId, or has an External Name.
-See, for example, SimplEnv Note [Global Ids in the substitution].
-
For the alternatives where we inject the binding, we can transfer
all x's OccInfo to b. And that is the point.
+Notice that
+ * The deliberate shadowing of 'x'.
+ * That (a) rapidly becomes false, so no bindings are injected.
+
The reason for doing these transformations here is because it allows
us to adjust the OccInfo for 'x' and 'b' as we go.
The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding
{x=b}; it's Nothing if the binder-swap doesn't happen.
+Note [Binder swap on GlobalId scrutinees]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the scrutinee is a GlobalId we must take care in two ways
+
+ i) In order to *know* whether 'x' occurs free in the RHS, we need its
+ occurrence info. BUT, we don't gather occurrence info for
+ GlobalIds. That's what the (small) occ_scrut_ids set in OccEnv is
+ for: it says "gather occurrence info for these.
+
+ ii) We must call localiseId on 'x' first, in case it's a GlobalId, or
+ has an External Name. See, for example, SimplEnv Note [Global Ids in
+ the substitution].
+
Note [Case of cast]
~~~~~~~~~~~~~~~~~~~
Consider case (x `cast` co) of b { I# ->
(usg_wo_scrut, scrut_var') = tagBinder alt_usg (localiseId scrut_var)
-- Note the localiseId; we're making a new binding
-- for it, and it might have an External Name, or
- -- even be a GlobalId
+ -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]
shadowing bndr = bndr `elemVarSet` rhs_fvs
rhs_fvs = exprFreeVars scrut_rhs
\begin{code}
data OccEnv
- = OccEnv OccEncl -- Enclosing context information
- CtxtTy -- Tells about linearity
+ = OccEnv { occ_encl :: !OccEncl -- Enclosing context information
+ , occ_ctxt :: !CtxtTy -- Tells about linearity
+ , occ_scrut_ids :: !GblScrutIds }
+
+type GblScrutIds = IdSet -- GlobalIds that are scrutinised, and for which
+ -- we want to gather occurence info; see
+ -- Note [Binder swap for GlobalId scrutinee]
+ -- No need to prune this if there's a shadowing binding
+ -- because it's OK for it to be too big
-- OccEncl is used to control whether to inline into constructor arguments
-- For example:
-- the CtxtTy inside applies
initOccEnv :: OccEnv
-initOccEnv = OccEnv OccRhs []
-
-vanillaCtxt :: OccEnv
-vanillaCtxt = OccEnv OccVanilla []
-
-rhsCtxt :: OccEnv
-rhsCtxt = OccEnv OccRhs []
+initOccEnv = OccEnv { occ_encl = OccRhs
+ , occ_ctxt = []
+ , occ_scrut_ids = emptyVarSet }
+
+vanillaCtxt :: OccEnv -> OccEnv
+vanillaCtxt env = OccEnv { occ_encl = OccVanilla, occ_ctxt = []
+ , occ_scrut_ids = occ_scrut_ids env }
+
+rhsCtxt :: OccEnv -> OccEnv
+rhsCtxt env = OccEnv { occ_encl = OccRhs, occ_ctxt = []
+ , occ_scrut_ids = occ_scrut_ids env }
+
+mkAltEnv :: OccEnv -> Maybe (Id, CoreExpr) -> OccEnv
+-- Does two things: a) makes the occ_ctxt = OccVanilla
+-- b) extends the scrut_ids if necessary
+mkAltEnv env (Just (scrut_id, _))
+ | not (isLocalId scrut_id)
+ = OccEnv { occ_encl = OccVanilla
+ , occ_scrut_ids = extendVarSet (occ_scrut_ids env) scrut_id
+ , occ_ctxt = occ_ctxt env }
+mkAltEnv env _
+ | isRhsEnv env = env { occ_encl = OccVanilla }
+ | otherwise = env
+
+setCtxtTy :: OccEnv -> CtxtTy -> OccEnv
+setCtxtTy env ctxt = env { occ_ctxt = ctxt }
isRhsEnv :: OccEnv -> Bool
-isRhsEnv (OccEnv OccRhs _) = True
-isRhsEnv (OccEnv OccVanilla _) = False
-
-setVanillaCtxt :: OccEnv -> OccEnv
-setVanillaCtxt (OccEnv OccRhs ctxt_ty) = OccEnv OccVanilla ctxt_ty
-setVanillaCtxt other_env = other_env
-
-setCtxt :: OccEnv -> CtxtTy -> OccEnv
-setCtxt (OccEnv encl _) ctxt = OccEnv encl ctxt
+isRhsEnv (OccEnv { occ_encl = OccRhs }) = True
+isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False
oneShotGroup :: OccEnv -> [CoreBndr] -> [CoreBndr]
-- The result binders have one-shot-ness set that they might not have had originally.
-- linearity context knows that c,n are one-shot, and it records that fact in
-- the binder. This is useful to guide subsequent float-in/float-out tranformations
-oneShotGroup (OccEnv _encl ctxt) bndrs
+oneShotGroup (OccEnv { occ_ctxt = ctxt }) bndrs
= go ctxt bndrs []
where
go _ [] rev_bndrs = reverse rev_bndrs
go ctxt (bndr:bndrs) rev_bndrs = go ctxt bndrs (bndr:rev_bndrs)
addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv
-addAppCtxt (OccEnv encl ctxt) args
- = OccEnv encl (replicate (valArgCount args) True ++ ctxt)
+addAppCtxt env@(OccEnv { occ_ctxt = ctxt }) args
+ = env { occ_ctxt = replicate (valArgCount args) True ++ ctxt }
\end{code}
%************************************************************************
\begin{code}
mkOneOcc :: OccEnv -> Id -> InterestingCxt -> UsageDetails
-mkOneOcc _env id int_cxt
+mkOneOcc env id int_cxt
| isLocalId id = unitVarEnv id (OneOcc False True int_cxt)
- | otherwise = emptyDetails
+ | id `elemVarSet` occ_scrut_ids env = unitVarEnv id NoOccInfo
+ | otherwise = emptyDetails
markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo