diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/Id.hs | 9 | ||||
| -rw-r--r-- | compiler/simplCore/Simplify.hs | 3 | ||||
| -rw-r--r-- | compiler/stranal/WwLib.hs | 7 |
3 files changed, 13 insertions, 6 deletions
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 8a5e28a235..290e26291d 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -53,7 +53,7 @@ module Id ( setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo, zapIdUsedOnceInfo, zapIdTailCallInfo, - zapFragileIdInfo, zapIdStrictness, + zapFragileIdInfo, zapIdStrictness, zapStableUnfolding, transferPolyIdInfo, -- ** Predicates on Ids @@ -117,7 +117,7 @@ module Id ( #include "HsVersions.h" import DynFlags -import CoreSyn ( CoreRule, evaldUnfolding, Unfolding( NoUnfolding ) ) +import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding, Unfolding( NoUnfolding ) ) import IdInfo import BasicTypes @@ -867,6 +867,11 @@ zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo zapIdTailCallInfo :: Id -> Id zapIdTailCallInfo = zapInfo zapTailCallInfo +zapStableUnfolding :: Id -> Id +zapStableUnfolding id + | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding + | otherwise = id + {- Note [transferPolyIdInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 1c5534f3ab..8bccbfef54 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -1519,8 +1519,7 @@ simplLam env (bndr:bndrs) body (ApplyToVal { sc_arg = arg, sc_env = arg_se ; simplNonRecE env zapped_bndr (arg, arg_se) (bndrs, body) cont } where zapped_bndr -- See Note [Zap unfolding when beta-reducing] - | isId bndr, isStableUnfolding (realIdUnfolding bndr) - = setIdUnfolding bndr NoUnfolding + | isId bndr = zapStableUnfolding bndr | otherwise = bndr -- discard a non-counting tick on a lambda. This may change the diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index 8d41426935..f83aafe7b0 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -587,8 +587,11 @@ mkWWstr_one dflags fam_envs arg ; let unpk_args = zipWith3 mk_ww_arg uniqs inst_con_arg_tys cs unbox_fn = mkUnpackCase (Var arg) co uniq1 data_con unpk_args - rebox_fn = Let (NonRec arg con_app) - con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co + arg_no_unf = zapStableUnfolding arg + -- See Note [Zap unfolding when beta-reducing] + -- in Simplify.hs; and see Trac #13890 + rebox_fn = Let (NonRec arg_no_unf con_app) + con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs unpk_args ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } -- Don't pass the arg, rebox instead |