summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-06-02 00:35:22 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-06-10 02:38:19 -0400
commitf4a5e30e7b027894535872164df50c300d8e6b0f (patch)
treeb213dc12c444d4c3e4e33da4a5d9f9311aeba071
parentd69067a1b920f1122f55dd9caa39cf9ed9ba1d9b (diff)
downloadhaskell-f4a5e30e7b027894535872164df50c300d8e6b0f.tar.gz
Do not add unfoldings to lambda-binders
For reasons described in GHC.Core.Opt.Simplify Historical Note [Case binders and join points], we used to keep a Core unfolding in one of the lambda-binders for a join point. But this was always a gross hack -- it's very odd to have an unfolding in a lambda binder, that refers to earlier lambda binders. The hack bit us in various ways: * Most seriously, it is incompatible with linear types in Core. * It complicated demand analysis, and could worsen results * It required extra care in the simplifier (simplLamBinder) * It complicated !5641 (look for "join binder unfoldings") So this patch just removes the hack. Happily, doind so turned out to have no effect on performance.
-rw-r--r--compiler/GHC/Core/Lint.hs6
-rw-r--r--compiler/GHC/Core/Opt/DmdAnal.hs21
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs77
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap/Utils.hs5
-rw-r--r--compiler/GHC/Types/Id/Info.hs2
5 files changed, 23 insertions, 88 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index fdef694cec..f8dbce7652 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -2650,11 +2650,9 @@ we behave as follows (#15057, #T15664):
Note [Linting linearity]
~~~~~~~~~~~~~~~~~~~~~~~~
-There are two known optimisations that have not yet been updated
+There is one known optimisations that have not yet been updated
to work with Linear Lint:
-* Lambda-bound variables with unfoldings
- (see Note [Case binders and join points] and ticket #17530)
* Optimisations can create a letrec which uses a variable linearly, e.g.
letrec f True = f False
f False = x
@@ -2663,7 +2661,7 @@ to work with Linear Lint:
Plan: make let-bound variables remember the usage environment.
See ticket #18694.
-We plan to fix both of the issues in the very near future.
+We plan to fix this issue in the very near future.
For now, -dcore-lint enables only linting output of the desugarer,
and full Linear Lint has to be enabled separately with -dlinear-core-lint.
Ticket #19165 concerns enabling Linear Lint with -dcore-lint.
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 14ee7419bf..bad3234ca9 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -1295,16 +1295,9 @@ annotateLamIdBndr env dmd_ty id
-- Only called for Ids
= assert (isId id) $
-- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty, ppr final_ty]) $
- WithDmdType final_ty new_id
+ WithDmdType main_ty new_id
where
- new_id = setIdDemandInfo id dmd
- -- Watch out! See note [Lambda-bound unfoldings]
- final_ty = case maybeUnfoldingTemplate (idUnfolding id) of
- Nothing -> main_ty
- Just unf -> main_ty `plusDmdType` unf_ty
- where
- (unf_ty, _) = dmdAnalStar env dmd unf
-
+ new_id = setIdDemandInfo id dmd
main_ty = addDemand dmd dmd_ty'
WithDmdType dmd_ty' dmd = findBndrDmd env dmd_ty id
@@ -1376,16 +1369,6 @@ mentioned in the (unsound) strictness signature, conservatively approximate the
demand put on them (topDmd), and add that to the "lazy_fv" returned by "dmdFix".
-Note [Lambda-bound unfoldings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We allow a lambda-bound variable to carry an unfolding, a facility that is used
-exclusively for join points; see Note [Case binders and join points]. If so,
-we must be careful to demand-analyse the RHS of the unfolding! Example
- \x. \y{=Just x}. <body>
-Then if <body> uses 'y', then transitively it uses 'x', and we must not
-forget that fact, otherwise we might make 'x' absent when it isn't.
-
-
************************************************************************
* *
\subsection{Strictness signatures}
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....
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 839c2ccd68..8416718c99 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -1001,10 +1001,7 @@ unbox_one_arg opts arg cs
arg_ids' = zipWithEqual "unbox_one_arg" setIdDemandInfo arg_ids cs
unbox_fn = mkUnpackCase (Var arg) co (idMult arg)
dc (ex_tvs' ++ arg_ids')
- arg_no_unf = zapStableUnfolding arg
- -- See Note [Zap unfolding when beta-reducing]
- -- in GHC.Core.Opt.Simplify; and see #13890
- rebox_fn = Let (NonRec arg_no_unf con_app)
+ rebox_fn = Let (NonRec arg con_app)
con_app = mkConApp2 dc tc_args (ex_tvs' ++ arg_ids') `mkCast` mkSymCo co
; (_, worker_args, wrap_fn, work_fn) <- mkWWstr opts NotArgOfInlineableFun (ex_tvs' ++ arg_ids')
; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) }
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 5849b8c283..027c162198 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -670,6 +670,8 @@ zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })
new_unf = zapFragileUnfolding unf
zapFragileUnfolding :: Unfolding -> Unfolding
+-- ^ Zaps any core unfolding, but /preserves/ evaluated-ness,
+-- i.e. an unfolding of OtherCon
zapFragileUnfolding unf
| hasCoreUnfolding unf = noUnfolding
| otherwise = unf