X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSubst.lhs;h=b02bc805784b21986e809d433c288cb757556f79;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hp=3fe48009a8b3f9e474ab957ec23c871bc5feb438;hpb=794c2f4c8829ba3166c9bdb471856bc00c21f001;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index 3fe4800..b02bc80 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -13,7 +13,7 @@ module CoreSubst ( -- ** Substituting into expressions and related types deShadowBinds, substSpec, substRulesForImportedIds, substTy, substExpr, substBind, substUnfolding, - substInlineRuleGuidance, lookupIdSubst, lookupTvSubst, substIdOcc, + substInlineRuleInfo, lookupIdSubst, lookupTvSubst, substIdOcc, -- ** Operations on substitutions emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst, @@ -48,6 +48,7 @@ import IdInfo import Unique import UniqSupply import Maybes +import BasicTypes ( isAlwaysActive ) import Outputable import PprCore () -- Instances import FastString @@ -509,27 +510,25 @@ substUnfolding subst (DFunUnfolding con args) substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_guidance = guide@(InlineRule {}) }) -- Retain 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_info `seq` + unf { uf_tmpl = new_tmpl, uf_guidance = guide { ir_info = new_info } } where - new_tmpl = substExpr subst tmpl - new_mb_wkr = substInlineRuleGuidance subst (ug_ir_info guide) + new_tmpl = substExpr subst tmpl + new_info = substInlineRuleInfo subst (ir_info guide) 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 +substInlineRuleInfo :: Subst -> InlineRuleInfo -> InlineRuleInfo +substInlineRuleInfo (Subst in_scope ids _) (InlWrapper wkr) + | Just (Var w1) <- lookupVarEnv ids wkr = InlWrapper w1 + | Just w1 <- lookupInScope in_scope wkr = InlWrapper w1 + | otherwise = WARN( True, text "Interesting! CoreSubst.substWorker:" <+> ppr wkr ) + InlVanilla -- Note [Worker inlining] +substInlineRuleInfo _ info = info ------------------ substIdOcc :: Subst -> Id -> Id @@ -583,6 +582,18 @@ substVarSet subst fvs | 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 @@ -667,6 +678,7 @@ simpleOptExpr expr | isId b -- let x = e in , safe_to_inline (idOccInfo b) || exprIsTrivial r' + , isAlwaysActive (idInlineActivation b) -- Note [Inline prag in simplOpt] = Left (extendIdSubst subst b r') | otherwise @@ -682,3 +694,22 @@ simpleOptExpr expr 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