Do not add unfoldings to lambda-binderswip/T17530

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.

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....