-- ** Substituting into expressions and related types
deShadowBinds, substSpec, substRulesForImportedIds,
substTy, substExpr, substBind, substUnfolding,
- substInlineRuleGuidance, lookupIdSubst, lookupTvSubst, substIdOcc,
+ substUnfoldingSource, lookupIdSubst, lookupTvSubst, substIdOcc,
-- ** Operations on substitutions
emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
import Unique
import UniqSupply
import Maybes
+import BasicTypes ( isAlwaysActive )
import Outputable
import PprCore () -- Instances
import FastString
-- No left-right shadowing
-- ie the substitution for (\x \y. e) a1 a2
-- so neither x nor y scope over a1 a2
-mkOpenSubst :: [(Var,CoreArg)] -> Subst
-mkOpenSubst pairs = Subst (mkInScopeSet (exprsFreeVars (map snd pairs)))
- (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
- (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
+mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst
+mkOpenSubst in_scope pairs = Subst in_scope
+ (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
+ (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
------------------------------
isInScope :: Var -> Subst -> Bool
substUnfolding subst (DFunUnfolding con args)
= DFunUnfolding con (map (substExpr subst) args)
-substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) })
+substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })
-- Retain an InlineRule!
+ | not (isInlineRuleSource src) -- Always zap a CoreUnfolding, to save substitution work
+ = NoUnfolding
+ | otherwise -- But keep an InlineRule!
= seqExpr new_tmpl `seq`
- new_mb_wkr `seq`
- unf { uf_tmpl = new_tmpl, uf_guidance = guide { ug_ir_info = new_mb_wkr } }
+ new_src `seq`
+ unf { uf_tmpl = new_tmpl, uf_src = new_src }
where
- new_tmpl = substExpr subst tmpl
- new_mb_wkr = substInlineRuleGuidance subst (ug_ir_info guide)
+ new_tmpl = substExpr subst tmpl
+ new_src = substUnfoldingSource subst src
-substUnfolding _ (CoreUnfolding {}) = NoUnfolding -- Discard
- -- Always zap a CoreUnfolding, to save substitution work
-
-substUnfolding _ unf = unf -- Otherwise no substitution to do
+substUnfolding _ unf = unf -- NoUnfolding, OtherCon
-------------------
-substInlineRuleGuidance :: Subst -> InlineRuleInfo -> InlineRuleInfo
-substInlineRuleGuidance subst (InlWrapper wkr)
- = case lookupIdSubst subst wkr of
- Var w1 -> InlWrapper w1
- other -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr wkr )
- InlUnSat -- Worker has got substituted away altogether
- -- (This can happen if it's trivial, via
- -- postInlineUnconditionally, hence only warning)
-substInlineRuleGuidance _ info = info
+substUnfoldingSource :: Subst -> UnfoldingSource -> UnfoldingSource
+substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
+ | Just wkr_expr <- lookupVarEnv ids wkr
+ = case wkr_expr of
+ Var w1 -> InlineWrapper w1
+ _other -> WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr
+ <+> equals <+> ppr wkr_expr ) -- Note [Worker inlining]
+ InlineRule -- It's not a wrapper any more, but still inline it!
+
+ | Just w1 <- lookupInScope in_scope wkr = InlineWrapper w1
+ | otherwise = WARN( True, text "Interesting! CoreSubst.substWorker2:" <+> ppr wkr )
+ -- This can legitimately happen. The worker has been inlined and
+ -- dropped as dead code, because we don't treat the UnfoldingSource
+ -- as an "occurrence".
+ -- Note [Worker inlining]
+ InlineRule
+
+substUnfoldingSource _ src = src
------------------
substIdOcc :: Subst -> Id -> Id
| otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
\end{code}
+Note [Worker inlining]
+~~~~~~~~~~~~~~~~~~~~~~
+A worker can get sustituted away entirely.
+ - it might be trivial
+ - it might simply be very small
+We do not treat an InlWrapper as an 'occurrence' in the occurence
+analyser, so it's possible that the worker is not even in scope any more.
+
+In all all these cases we simply drop the special case, returning to
+InlVanilla. The WARN is just so I can see if it happens a lot.
+
+
%************************************************************************
%* *
The Very Simple Optimiser
| isId b -- let x = e in <body>
, safe_to_inline (idOccInfo b) || exprIsTrivial r'
+ , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt]
= Left (extendIdSubst subst b r')
| otherwise
safe_to_inline (IAmALoopBreaker {}) = False
safe_to_inline NoOccInfo = False
\end{code}
+
+Note [Inline prag in simplOpt]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If there's an INLINE/NOINLINE pragma that restricts the phase in
+which the binder can be inlined, we don't inline here; after all,
+we don't know what phase we're in. Here's an example
+
+ foo :: Int -> Int -> Int
+ {-# INLINE foo #-}
+ foo m n = inner m
+ where
+ {-# INLINE [1] inner #-}
+ inner m = m+n
+
+ bar :: Int -> Int
+ bar n = foo n 1
+
+When inlining 'foo' in 'bar' we want the let-binding for 'inner'
+to remain visible until Phase 1
\ No newline at end of file
projects / ghc-hetmet.git / blobdiff