import Id
import IdInfo
import InstEnv
-import NewDemand
+import Demand
import BasicTypes
import Name hiding (varName)
import NameSet
binds implicit_binds imp_rules
; let { ext_rules = findExternalRules omit_prags binds imp_rules unfold_env }
+ -- Glom together imp_rules and rules currently attached to binders
+ -- Then pick just the ones we need to expose
-- See Note [Which rules to expose]
; let { (tidy_env, tidy_binds)
(varSetElems spec_ids) -- XXX non-det ordering
idinfo = idInfo id
- dont_inline = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
+ never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
loop_breaker = isNonRuleLoopBreaker (occInfo idinfo)
- bottoming_fn = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
+ bottoming_fn = isBottomingSig (strictnessInfo idinfo `orElse` topSig)
spec_ids = specInfoFreeVars (specInfo idinfo)
-- Stuff to do with the Id's unfolding
mb_unfold_ids :: Maybe (IdSet, [Id]) -- Nothing => don't unfold
mb_unfold_ids = case unfoldingInfo idinfo of
- CoreUnfolding { uf_tmpl = unf_rhs, uf_guidance = guide }
- | expose_all || -- expose_all says to expose all
- -- unfoldings willy-nilly
- not (bottoming_fn -- No need to inline bottom functions
- || dont_inline -- Or ones that say not to
- || loop_breaker -- Or that are loop breakers
- || neverUnfoldGuidance guide)
+ CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_guidance = guide }
+ | show_unfolding src guide
-> Just (exprFvsInOrder unf_rhs)
DFunUnfolding _ ops -> Just (exprsFvsInOrder ops)
- _ -> Nothing
+ _ -> Nothing
+
+ show_unfolding unf_source unf_guidance
+ = expose_all -- 'expose_all' says to expose all
+ -- unfoldings willy-nilly
+
+ || isInlineRuleSource unf_source -- Always expose things whose
+ -- source is an inline rule
+
+ || not (bottoming_fn -- No need to inline bottom functions
+ || never_active -- Or ones that say not to
+ || loop_breaker -- Or that are loop breakers
+ || neverUnfoldGuidance unf_guidance)
-- We want a deterministic free-variable list. exprFreeVars gives us
-- a VarSet, which is in a non-deterministic order when converted to a
-- the RHS is bottom, it should jolly well be exposed
_bottom_exposed = case exprBotStrictness_maybe rhs of
Nothing -> True
- Just (arity, _) -> appIsBottom str arity
+ Just (arity, _) -> appIsBottom str_sig arity
where
- str = newStrictnessInfo idinfo `orElse` topSig
-
- bndr1 = mkGlobalId details name' ty' idinfo'
- details = idDetails bndr -- Preserve the IdDetails
- ty' = tidyTopType (idType bndr)
- rhs1 = tidyExpr rhs_tidy_env rhs
- idinfo = idInfo bndr
- idinfo' = tidyTopIdInfo (isExternalName name')
+
+
+ bndr1 = mkGlobalId details name' ty' idinfo'
+ details = idDetails bndr -- Preserve the IdDetails
+ ty' = tidyTopType (idType bndr)
+ rhs1 = tidyExpr rhs_tidy_env rhs
+ idinfo = idInfo bndr
+ unf_info = unfoldingInfo idinfo
+ str_sig = strictnessInfo idinfo `orElse` topSig
+ is_bot = isBottomingSig str_sig
+ idinfo' = tidyTopIdInfo (isExternalName name')
idinfo unfold_info
arity caf_info
(occInfo idinfo)
- unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs1 (unfoldingInfo idinfo)
+ unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs1 is_bot unf_info
| otherwise = noUnfolding
-- NB: do *not* expose the worker if show_unfold is off,
-- because that means this thing is a loop breaker or
`setOccInfo` robust_occ_info
`setCafInfo` caf_info
`setArityInfo` arity
- `setAllStrictnessInfo` newStrictnessInfo idinfo
+ `setStrictnessInfo` strictnessInfo idinfo
| otherwise -- Externally-visible Ids get the whole lot
= vanillaIdInfo
`setOccInfo` robust_occ_info
`setCafInfo` caf_info
`setArityInfo` arity
- `setAllStrictnessInfo` newStrictnessInfo idinfo
+ `setStrictnessInfo` strictnessInfo idinfo
`setInlinePragInfo` inlinePragInfo idinfo
`setUnfoldingInfo` unfold_info
-- NB: we throw away the Rules
------------ Unfolding --------------
-tidyUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding
-tidyUnfolding tidy_env _ unf@(CoreUnfolding { uf_tmpl = rhs
- , uf_guidance = guide@(InlineRule {}) })
- = unf { uf_tmpl = tidyExpr tidy_env rhs, -- Preserves OccInfo
- uf_guidance = guide { ir_info = tidyInl tidy_env (ir_info guide) } }
-tidyUnfolding tidy_env _ (DFunUnfolding con ids)
+tidyUnfolding :: TidyEnv -> CoreExpr -> Bool -> Unfolding -> Unfolding
+tidyUnfolding tidy_env _ _ (DFunUnfolding con ids)
= DFunUnfolding con (map (tidyExpr tidy_env) ids)
-tidyUnfolding _ tidy_rhs (CoreUnfolding {})
- = mkTopUnfolding tidy_rhs
-tidyUnfolding _ _ unf = unf
-
-tidyInl :: TidyEnv -> InlineRuleInfo -> InlineRuleInfo
-tidyInl tidy_env (InlWrapper w) = InlWrapper (tidyVarOcc tidy_env w)
-tidyInl _ inl_info = inl_info
+tidyUnfolding tidy_env tidy_rhs is_bottoming
+ unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
+ | isInlineRuleSource src
+ = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo
+ uf_src = tidyInl tidy_env src }
+ | otherwise
+ = mkTopUnfolding is_bottoming tidy_rhs
+tidyUnfolding _ _ _ unf = unf
+
+tidyInl :: TidyEnv -> UnfoldingSource -> UnfoldingSource
+tidyInl tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
+tidyInl _ inl_info = inl_info
\end{code}
%************************************************************************