diff options
Diffstat (limited to 'compiler/GHC/Core/Opt/Simplify.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 77 |
1 files changed, 16 insertions, 61 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 19705f5541..b799c1df59 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -15,7 +15,6 @@ import GHC.Prelude import GHC.Platform import GHC.Driver.Session import GHC.Driver.Ppr -import GHC.Driver.Config import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env @@ -50,7 +49,7 @@ import GHC.Core.Unfold.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..) , pushCoTyArg, pushCoValArg - , idArityType, etaExpandAT ) + , etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) @@ -1520,17 +1519,13 @@ simplLam env (bndr:bndrs) body (ApplyToVal { sc_arg = arg, sc_env = arg_se | isSimplified dup -- Don't re-simplify if we've simplified it once -- See Note [Avoiding exponential behaviour] = do { tick (BetaReduction bndr) - ; (floats1, env') <- simplNonRecX env zapped_bndr arg + ; (floats1, env') <- simplNonRecX env bndr arg ; (floats2, expr') <- simplLam env' bndrs body cont ; return (floats1 `addFloats` floats2, expr') } | otherwise = do { tick (BetaReduction bndr) - ; simplNonRecE env zapped_bndr (arg, arg_se) (bndrs, body) cont } - where - zapped_bndr -- See Note [Zap unfolding when beta-reducing] - | isId bndr = zapStableUnfolding bndr - | otherwise = bndr + ; simplNonRecE env bndr (arg, arg_se) (bndrs, body) cont } -- Discard a non-counting tick on a lambda. This may change the -- cost attribution slightly (moving the allocation of the @@ -1549,26 +1544,11 @@ simplLam env bndrs body cont ------------- simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr) --- Used for lambda binders. These sometimes have unfoldings added by --- the worker/wrapper pass that must be preserved, because they can't --- be reconstructed from context. For example: --- f x = case x of StrictPair a b -> fw a b x --- fw a{=OtherCon[]} b{=OtherCon[]} x{=(StrictPair a b)} = ... --- The "{=(StrictPair a b)}" is an unfolding we can't reconstruct otherwise. --- Since simplBinder already retains OtherCon bindings we only have to special --- case core unfoldings like the one for `x`. -simplLamBndr env bndr - | isId bndr && hasCoreUnfolding old_unf -- Special case - = do { (env1, bndr1) <- simplBinder env bndr - ; unf' <- simplStableUnfolding env1 NotTopLevel Nothing bndr - (idType bndr1) (idArityType bndr1) old_unf - ; let bndr2 = bndr1 `setIdUnfolding` unf' - ; return (modifyInScope env1 bndr2, bndr2) } - - | otherwise - = simplBinder env bndr -- Normal case - where - old_unf = idUnfolding bndr +-- Historically this had a special case for when a lambda-binder +-- could have a stable unfolding; +-- see Historical Note [Case binders and join points] +-- But now it is much simpler! +simplLamBndr env bndr = simplBinder env bndr simplLamBndrs :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr]) simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs @@ -1693,19 +1673,6 @@ simplify BIG True; maybe good things happen. That is why (see Note [Trying rewrite rules]) -Note [Zap unfolding when beta-reducing] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Lambda-bound variables can have stable unfoldings, such as - $j = \x. \b{Unf=Just x}. e -See Note [Case binders and join points] below; the unfolding for lets -us optimise e better. However when we beta-reduce it we want to -revert to using the actual value, otherwise we can end up in the -stupid situation of - let x = blah in - let b{Unf=Just x} = y - in ...b... -Here it'd be far better to drop the unfolding and use the actual RHS. - ************************************************************************ * * Join points @@ -3508,27 +3475,11 @@ mkDupableAlt platform case_bndr jfloats (Alt con bndrs' rhs') = return (jfloats, Alt con bndrs' rhs') | otherwise - = do { simpl_opts <- initSimpleOpts <$> getDynFlags - ; let rhs_ty' = exprType rhs' - scrut_ty = idType case_bndr - case_bndr_w_unf - = case con of - DEFAULT -> case_bndr - DataAlt dc -> setIdUnfolding case_bndr unf - where - -- See Note [Case binders and join points] - unf = mkInlineUnfolding simpl_opts rhs - rhs = mkConApp2 dc (tyConAppArgs scrut_ty) bndrs' - - LitAlt {} -> warnPprTrace True - (text "mkDupableAlt" <+> ppr case_bndr <+> ppr con) - case_bndr - -- The case binder is alive but trivial, so why has - -- it not been substituted away? + = do { let rhs_ty' = exprType rhs' final_bndrs' | isDeadBinder case_bndr = filter abstract_over bndrs' - | otherwise = bndrs' ++ [case_bndr_w_unf] + | otherwise = bndrs' ++ [case_bndr] abstract_over bndr | isTyVar bndr = True -- Abstract over all type variables just in case @@ -3587,8 +3538,12 @@ the case rn cancels with. See #4957 a fuller example. -Note [Case binders and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Historical Note [Case binders and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +NB: this entire Note is now irrelevant. In Jun 21 we stopped +adding unfoldings to lambda binders (#17530). It was always a +hack and bit us in multiple small and not-so-small ways + Consider this case (case .. ) of c { I# c# -> ....c.... |