import DynFlags
import CoreSyn
import PprCore () -- Instances
-import TcType ( tcSplitSigmaTy, tcSplitDFunHead )
-import OccurAnal
+import TcType ( tcSplitDFunTy )
+import OccurAnal ( occurAnalyseExpr )
import CoreSubst hiding( substTy )
import CoreFVs ( exprFreeVars )
import CoreArity ( manifestArity, exprBotStrictness_maybe )
import PrimOp
import IdInfo
import BasicTypes ( Arity )
-import TcType ( tcSplitDFunTy )
-import Type
+import Type
import Coercion
import PrelNames
import VarEnv ( mkInScopeSet )
mkDFunUnfolding dfun_ty ops
= DFunUnfolding dfun_nargs data_con ops
where
- (tvs, theta, head_ty) = tcSplitSigmaTy dfun_ty
- -- NB: tcSplitSigmaTy: do not look through a newtype
- -- when the dictionary type is a newtype
- (cls, _) = tcSplitDFunHead head_ty
- dfun_nargs = length tvs + length theta
+ (tvs, n_theta, cls, _) = tcSplitDFunTy dfun_ty
+ dfun_nargs = length tvs + n_theta
data_con = classDataCon cls
mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
-- be a loop breaker (maybe the knot is not yet untied)
CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top
, uf_is_cheap = is_cheap, uf_arity = uf_arity
- , uf_guidance = guidance }
+ , uf_guidance = guidance, uf_expandable = is_exp }
| active_unfolding -> tryUnfolding dflags id lone_variable
arg_infos cont_info unf_template is_top
- is_cheap uf_arity guidance
+ is_cheap is_exp uf_arity guidance
| otherwise -> Nothing
NoUnfolding -> Nothing
OtherCon {} -> Nothing
DFunUnfolding {} -> Nothing -- Never unfold a DFun
tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt
- -> CoreExpr -> Bool -> Bool -> Arity -> UnfoldingGuidance
+ -> CoreExpr -> Bool -> Bool -> Bool -> Arity -> UnfoldingGuidance
-> Maybe CoreExpr
tryUnfolding dflags id lone_variable
arg_infos cont_info unf_template is_top
- is_cheap uf_arity guidance
+ is_cheap is_exp uf_arity guidance
-- uf_arity will typically be equal to (idArity id),
-- but may be less for InlineRules
| dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
text "uf arity" <+> ppr uf_arity,
text "interesting continuation" <+> ppr cont_info,
text "some_benefit" <+> ppr some_benefit,
+ text "is exp:" <+> ppr is_exp,
text "is cheap:" <+> ppr is_cheap,
text "guidance" <+> ppr guidance,
extra_doc,
interesting_saturated_call
= case cont_info of
- BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions]
+ BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions]
CaseCtxt -> not (lone_variable && is_cheap) -- Note [Lone variables]
- ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt]
- ValAppCtxt -> True -- Note [Cast then apply]
+ ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt]
+ ValAppCtxt -> True -- Note [Cast then apply]
(yes_or_no, extra_doc)
= case guidance of
, let sat = length args == dfun_nargs -- See Note [DFun arity check]
in if sat then True else
pprTrace "Unsaturated dfun" (ppr fun <+> int dfun_nargs $$ ppr args) False
- , let (dfun_tvs, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun)
+ , let (dfun_tvs, _n_theta, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun)
subst = zipOpenTvSubst dfun_tvs (stripTypeArgs (takeList dfun_tvs args))
mk_arg (DFunConstArg e) = e
mk_arg (DFunLamArg i) = args !! i