import Id
import IdInfo
import InstEnv
-import NewDemand
+import Demand
import BasicTypes
import Name hiding (varName)
import NameSet
= do { let { dflags = hsc_dflags hsc_env
; omit_prags = dopt Opt_OmitInterfacePragmas dflags
+ ; expose_all = dopt Opt_ExposeAllUnfoldings dflags
; th = dopt Opt_TemplateHaskell dflags
}
; showPass dflags "Tidy Core"
; let { implicit_binds = getImplicitBinds type_env }
; (unfold_env, tidy_occ_env)
- <- chooseExternalIds hsc_env mod omit_prags binds implicit_binds imp_rules
+ <- chooseExternalIds hsc_env mod omit_prags expose_all
+ 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)
ModDetails { md_types = tidy_type_env,
md_rules = tidy_rules,
md_insts = tidy_insts,
- md_vect_info = tidy_vect_info, md_fam_insts = fam_insts,
+ md_vect_info = tidy_vect_info,
+ md_fam_insts = fam_insts,
md_exports = exports,
md_anns = anns -- are already tidy
})
implicit_ids _ = []
get_defn :: Id -> CoreBind
- get_defn id = NonRec id (unfoldingTemplate (idUnfolding id))
+ get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))
\end{code}
chooseExternalIds :: HscEnv
-> Module
- -> Bool
+ -> Bool -> Bool
-> [CoreBind]
-> [CoreBind]
-> [CoreRule]
-> IO (UnfoldEnv, TidyOccEnv)
-- Step 1 from the notes above
-chooseExternalIds hsc_env mod omit_prags binds implicit_binds imp_id_rules
+chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules
= do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env
; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
; tidy_internal internal_ids unfold_env1 occ_env1 }
let
(new_ids, show_unfold)
| omit_prags = ([], False)
- | otherwise = addExternal refined_id
+ | otherwise = addExternal expose_all refined_id
-- 'idocc' is an *occurrence*, but we need to see the
-- unfolding in the *definition*; so look up in binder_set
let unfold_env' = extendVarEnv unfold_env id (name',False)
tidy_internal ids unfold_env' occ_env'
-addExternal :: Id -> ([Id],Bool)
-addExternal id = (new_needed_ids, show_unfold)
+addExternal :: Bool -> Id -> ([Id],Bool)
+addExternal expose_all id = (new_needed_ids, show_unfold)
where
new_needed_ids = unfold_ids ++
filter (\id -> isLocalId id &&
idinfo = idInfo id
dont_inline = 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 }
- | not bottoming_fn -- Not necessary
- , not dont_inline
- , not loop_breaker
- , not (neverUnfoldGuidance 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)
-> Just (exprFvsInOrder unf_rhs)
DFunUnfolding _ ops -> Just (exprsFvsInOrder ops)
_ -> Nothing
Nothing -> True
Just (arity, _) -> appIsBottom str arity
where
- str = newStrictnessInfo idinfo `orElse` topSig
+ str = strictnessInfo idinfo `orElse` topSig
bndr1 = mkGlobalId details name' ty' idinfo'
details = idDetails bndr -- Preserve the IdDetails
idinfo = idInfo bndr
idinfo' = tidyTopIdInfo (isExternalName name')
idinfo unfold_info
- arity caf_info
+ arity caf_info
+ (occInfo idinfo)
unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs1 (unfoldingInfo idinfo)
| otherwise = noUnfolding
-- unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
-- CoreToStg makes use of this when constructing SRTs.
tidyTopIdInfo :: Bool -> IdInfo -> Unfolding
- -> ArityInfo -> CafInfo
+ -> ArityInfo -> CafInfo -> OccInfo
-> IdInfo
-tidyTopIdInfo is_external idinfo unfold_info arity caf_info
+tidyTopIdInfo is_external idinfo unfold_info arity caf_info occ_info
| not is_external -- For internal Ids (not externally visible)
= vanillaIdInfo -- we only need enough info for code generation
-- Arity and strictness info are enough;
-- c.f. CoreTidy.tidyLetBndr
+ `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
-- They have already been extracted by findExternalRules
+ where
+ robust_occ_info = zapFragileOcc occ_info
+ -- It's important to keep loop-breaker information
+ -- when we are doing -fexpose-all-unfoldings
------------ 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)
= DFunUnfolding con (map (tidyExpr tidy_env) ids)
-tidyUnfolding _ tidy_rhs (CoreUnfolding {})
+tidyUnfolding tidy_env tidy_rhs 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 tidy_rhs
tidyUnfolding _ _ unf = unf
-tidyInl :: TidyEnv -> InlineRuleInfo -> InlineRuleInfo
-tidyInl tidy_env (InlWrapper w) = InlWrapper (tidyVarOcc tidy_env w)
-tidyInl _ inl_info = inl_info
+tidyInl :: TidyEnv -> UnfoldingSource -> UnfoldingSource
+tidyInl tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
+tidyInl _ inl_info = inl_info
\end{code}
%************************************************************************