import CoreUtils
import Rules
import CoreArity ( exprArity, exprBotStrictness_maybe )
-import Class ( classSelIds )
+import Class ( classAllSelIds )
import VarEnv
import VarSet
import Var
import DataCon
import TyCon
import Module
+import Packages( isDllName )
import HscTypes
import Maybes
import UniqSupply
= do { let { dflags = hsc_dflags hsc_env
; omit_prags = dopt Opt_OmitInterfacePragmas dflags
; expose_all = dopt Opt_ExposeAllUnfoldings dflags
- ; th = dopt Opt_TemplateHaskell dflags
+ ; th = xopt Opt_TemplateHaskell dflags
}
; showPass dflags CoreTidy
| isEnumerationTyCon tc -- For an enumeration, exposing the constructors
= True -- won't lead to the need for further exposure
-- (This includes data types with no constructors.)
- | isOpenTyCon tc -- Open type family
+ | isFamilyTyCon tc -- Open type family
= True
| otherwise -- Newtype, datatype
= map get_defn (concatMap implicit_ids (typeEnvElts type_env))
where
implicit_ids (ATyCon tc) = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
- implicit_ids (AClass cls) = classSelIds cls
+ implicit_ids (AClass cls) = classAllSelIds cls
implicit_ids _ = []
get_defn :: Id -> CoreBind
mb_unfold_ids :: Maybe (IdSet, [Id]) -- Nothing => don't unfold
mb_unfold_ids = case unfoldingInfo idinfo of
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
+ | show_unfolding src guide
+ -> Just (unf_ext_ids src unf_rhs)
+ DFunUnfolding _ _ ops -> Just (exprsFvsInOrder ops)
+ _ -> Nothing
+ where
+ unf_ext_ids (InlineWrapper v) _ = (unitVarSet v, [v])
+ unf_ext_ids _ unf_rhs = exprFvsInOrder unf_rhs
+ -- For a wrapper, externalise the wrapper id rather than the
+ -- fvs of the rhs. The two usually come down to the same thing
+ -- but I've seen cases where we had a wrapper id $w but a
+ -- rhs where $w had been inlined; see Trac #3922
show_unfolding unf_source unf_guidance
= expose_all -- 'expose_all' says to expose all
-- unfoldings willy-nilly
- || isInlineRuleSource unf_source -- Always expose things whose
+ || isStableSource unf_source -- Always expose things whose
-- source is an inline rule
|| not (bottoming_fn -- No need to inline bottom functions
------------ Unfolding --------------
tidyUnfolding :: TidyEnv -> CoreExpr -> Maybe StrictSig -> Unfolding -> Unfolding
-tidyUnfolding tidy_env _ _ (DFunUnfolding con ids)
- = DFunUnfolding con (map (tidyExpr tidy_env) ids)
+tidyUnfolding tidy_env _ _ (DFunUnfolding ar con ids)
+ = DFunUnfolding ar con (map (tidyExpr tidy_env) ids)
tidyUnfolding tidy_env tidy_rhs strict_sig
unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
- | isInlineRuleSource src
+ | isStableSource src
= unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo
uf_src = tidyInl tidy_env src }
| otherwise
\begin{code}
hasCafRefs :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
hasCafRefs this_pkg p arity expr
- | is_caf || mentions_cafs
- = MayHaveCafRefs
+ | is_caf || mentions_cafs = MayHaveCafRefs
| otherwise = NoCafRefs
where
mentions_cafs = isFastTrue (cafRefs p expr)
- is_caf = not (arity > 0 || rhsIsStatic this_pkg expr)
+ is_dynamic_name = isDllName this_pkg
+ is_caf = not (arity > 0 || rhsIsStatic is_dynamic_name expr)
-- NB. we pass in the arity of the expression, which is expected
-- to be calculated by exprArity. This is because exprArity