Fix arityType: -fpedantic-bottoms, join points, etcwip/T21694a

This MR fixes #21694, #21755.  It also makes sure that #21948 and
fix to #21694.

* For #21694 the underlying problem was that we were calling arityType
  on an expression that had free join points.  This is a Bad Bad Idea.
  See Note [No free join points in arityType].

* To make "no free join points in arityType" work out I had to avoid
  trying to use eta-expansion for runRW#. This entailed a few changes
  in the Simplifier's treatment of runRW#.  See
  GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#]

* I also made andArityType work correctly with -fpedantic-bottoms;
  see Note [Combining case branches: andWithTail].

* Rewrote Note [Combining case branches: optimistic one-shot-ness]

* arityType previously treated join points differently to other
  let-bindings. This patch makes them unform; arityType analyses
  the RHS of all bindings to get its ArityType, and extends am_sigs.

  I realised that, now we have am_sigs giving the ArityType for
  let-bound Ids, we don't need the (pre-dating) special code in
  arityType for join points. But instead we need to extend the env for
  Rec bindings, which weren't doing before.  More uniform now.  See
  Note [arityType for let-bindings].

  This meant we could get rid of ae_joins, and in fact get rid of
  EtaExpandArity altogether.  Simpler.

* And finally, it was the strange treatment of join-point Ids in
  arityType (involving a fake ABot type) that led to a serious bug:
  #21755.  Fixed by this refactoring, which treats them uniformly;
  but without breaking #18328.

  In fact, the arity for recursive join bindings is pretty tricky;
  see the long Note [Arity for recursive join bindings]
  in GHC.Core.Opt.Simplify.Utils.  That led to more refactoring,
  including deciding that an Id could have an Arity that is bigger
  than its JoinArity; see Note [Invariants on join points], item
  2(b) in GHC.Core

* Make sure that the "demand threshold" for join points in DmdAnal
  is no bigger than the join-arity.  In GHC.Core.Opt.DmdAnal see
  Note [Demand signatures are computed for a threshold arity based on idArity]

* I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity,
  where it more properly belongs.

* Remove an old, redundant hack in FloatOut.  The old Note was
  Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels.

Compile time improves very slightly on average:

Metrics: compile_time/bytes allocated
---------------------------------------------------------------------------------------
  T18223(normal) ghc/alloc    725,808,720    747,839,216  +3.0%  BAD
  T6048(optasm)  ghc/alloc    105,006,104    101,599,472  -3.2% GOOD
  geo. mean                                          -0.2%
  minimum                                            -3.2%
  maximum                                            +3.0%

For some reason Windows was better

   T10421(normal) ghc/alloc    125,888,360    124,129,168  -1.4% GOOD
   T18140(normal) ghc/alloc     85,974,520     83,884,224  -2.4% GOOD
  T18698b(normal) ghc/alloc    236,764,568    234,077,288  -1.1% GOOD
   T18923(normal) ghc/alloc     75,660,528     73,994,512  -2.2% GOOD
    T6048(optasm) ghc/alloc    112,232,512    108,182,520  -3.6% GOOD
  geo. mean                                          -0.6%

I had a quick look at T18223 but it is knee deep in coercions and
the size of everything looks similar before and after.  I decided
to accept that 3% increase in exchange for goodness elsewhere.

Metric Decrease:
    T10421
    T18140
    T18698b
    T18923
    T6048

Metric Increase:
    T18223

1 files changed, 28 insertions, 13 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 16b428cca4..ad1d87feae 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -43,7 +43,7 @@ module GHC.Core (
         -- ** Simple 'Expr' access functions and predicates
         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
         collectBinders, collectTyBinders, collectTyAndValBinders,
-        collectNBinders,
+        collectNBinders, collectNValBinders_maybe,
         collectArgs, stripNArgs, collectArgsTicks, flattenBinds,
         collectFunSimple,
 
@@ -746,17 +746,18 @@ Join points must follow these invariants:
          the binder.  Reason: if we want to push a continuation into
          the RHS we must push it into the unfolding as well.
 
-     2b. The Arity (in the IdInfo) of a join point is the number of value
-         binders in the top n lambdas, where n is the join arity.
+     2b. The Arity (in the IdInfo) of a join point varies independently of the
+         join-arity. For example, we could have
+             j x = case x of { T -> \y.y; F -> \y.3 }
+         Its join-arity is 1, but its idArity is 2; and we do not eta-expand
+         join points: see Note [Do not eta-expand join points] in
+                          GHC.Core.Opt.Simplify.Utils.
 
-         So arity <= join arity; the former counts only value binders
-         while the latter counts all binders.
-         e.g. Suppose $j has join arity 1
-               let j = \x y. e in case x of { A -> j 1; B -> j 2 }
-         Then its ordinary arity is also 1, not 2.
+         Allowing the idArity to be bigger than the join-arity is
+         important in arityType; see GHC.Core.Opt.Arity
+         Note [Arity for recursive join bindings]
 
-         The arity of a join point isn't very important; but short of setting
-         it to zero, it is helpful to have an invariant.  E.g. #17294.
+         Historical note: see #17294.
 
   3. If the binding is recursive, then all other bindings in the recursive group
      must also be join points.
@@ -1973,9 +1974,11 @@ collectBinders         :: Expr b   -> ([b],     Expr b)
 collectTyBinders       :: CoreExpr -> ([TyVar], CoreExpr)
 collectValBinders      :: CoreExpr -> ([Id],    CoreExpr)
 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
--- | Strip off exactly N leading lambdas (type or value). Good for use with
--- join points.
-collectNBinders        :: Int -> Expr b -> ([b], Expr b)
+
+-- | Strip off exactly N leading lambdas (type or value).
+-- Good for use with join points.
+-- Panic if there aren't enough
+collectNBinders :: JoinArity -> Expr b -> ([b], Expr b)
 
 collectBinders expr
   = go [] expr
@@ -2008,6 +2011,18 @@ collectNBinders orig_n orig_expr
     go n bs (Lam b e) = go (n-1) (b:bs) e
     go _ _  _         = pprPanic "collectNBinders" $ int orig_n
 
+-- | Strip off exactly N leading value lambdas
+-- returning all the binders found up to that point
+-- Return Nothing if there aren't enough
+collectNValBinders_maybe :: Arity -> CoreExpr -> Maybe ([Var], CoreExpr)
+collectNValBinders_maybe orig_n orig_expr
+  = go orig_n [] orig_expr
+  where
+    go 0 bs expr      = Just (reverse bs, expr)
+    go n bs (Lam b e) | isId b    = go (n-1) (b:bs) e
+                      | otherwise = go n     (b:bs) e
+    go _ _  _         = Nothing
+
 -- | Takes a nested application expression and returns the function
 -- being applied and the arguments to which it is applied
 collectArgs :: Expr b -> (Expr b, [Arg b])