Demand: Let `Boxed` win in `lubBoxity` (#21119)

Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic
in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox
parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent.

Until now, we thought that this hack pulled its weight becuase it worked around
some shortcomings of the phase separation between Boxity analysis and CPR
analysis. But it is a gross hack which caused regressions itself that needed all
kinds of fixes and workarounds. See for example #20767. It became impossible to
work with in !7599, so I want to remove it.

For example, at the moment, `lubDmd B dmd` will not unbox `dmd`,
but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of
the lattice, it's hardly justifiable to get a better demand when `lub`bing with
`A`.

The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress
 #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR
are able to communicate better. Fortunately, that is not the case since I could
tweak the other source of optimism in Boxity analysis that is described in
`Note [Unboxed demand on function bodies returning small products]` so that
we *recursively* assume unboxed demands on function bodies returning small
products. See the updated Note.

`Note [Boxity for bottoming functions]` describes why we need bottoming
functions to have signatures that say that they deeply unbox their arguments.
In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox
recursive data constructors. This is in line with our handling of them in CPR.
I updated `Note [Which types are unboxed?]` to reflect that.

In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler
implementation (at least to think about). We can also drop the very ad-hoc
definition of `deferAfterPreciseException` and its Note in favor of the
simple, intuitive definition we used to have.

Metric Decrease:
    T16875
    T18223
    T18698a
    T18698b
    hard_hole_fits
Metric Increase:
    LargeRecord
    MultiComponentModulesRecomp
    T15703
    T8095
    T9872d

Out of all the regresions, only the one in T9872d doesn't vanish in a perf
build, where the compiler is bootstrapped with -O2 and thus SpecConstr.
Reason for regressions:

  * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed.
    That is because the context is passed to a function argument, for
    example in `liftCoSubstTyVarBndrUsing`.
  * In T15703, LargeRecord and T8095, we get a bit more allocations in
    `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed.
    In both cases that guards against reboxing in some code paths.
  * The same is true for MultiComponentModulesRecomp, where we get less unboxing
    in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations
    actually *improve* by over 4%!

Results on NoFib:

--------------------------------------------------------------------------------
        Program         Allocs    Instrs
--------------------------------------------------------------------------------
         awards          -0.4%     +0.3%
      cacheprof          -0.3%     +2.4%
            fft          -1.5%     -5.1%
       fibheaps          +1.2%     +0.8%
          fluid          -0.3%     -0.1%
            ida          +0.4%     +0.9%
   k-nucleotide          +0.4%     -0.1%
     last-piece         +10.5%    +13.9%
           lift          -4.4%     +3.5%
        mandel2         -99.7%    -99.8%
           mate          -0.4%     +3.6%
         parser          -1.0%     +0.1%
         puzzle         -11.6%     +6.5%
reverse-complem          -3.0%     +2.0%
            scs          -0.5%     +0.1%
         sphere          -0.4%     -0.2%
      wave4main          -8.2%     -0.3%
--------------------------------------------------------------------------------
Summary excludes mandel2 because of excessive bias
            Min         -11.6%     -5.1%
            Max         +10.5%    +13.9%
 Geometric Mean          -0.2%     +0.3%
--------------------------------------------------------------------------------

Not bad for a bug fix.

The regression in `last-piece` could become a win if SpecConstr would work on
non-recursive functions. The regression in `fibheaps` is due to
`Note [Reboxed crud for bottoming calls]`, e.g., #21128.

7 files changed, 13 insertions, 15 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index a2c77f86ea..5ca8a9a503 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -98,7 +98,7 @@ end Rec }
 g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
 [GblId,
  Arity=3,
- Str=<1L><1L><1!L>,
+ Str=<1L><1L><1!P(L)>,
  Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/T13543.stderr b/testsuite/tests/simplCore/should_compile/T13543.stderr
index 485f6fea41..94c0b76bfc 100644
--- a/testsuite/tests/simplCore/should_compile/T13543.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13543.stderr
@@ -1,8 +1,8 @@
 
 ==================== Strictness signatures ====================
 Foo.$trModule:
-Foo.f: <1!P(1L)><1!L><1!L>
-Foo.g: <1!P(1!L,1!L)>
+Foo.f: <1!P(1L)><1!P(L)><1!P(L)>
+Foo.g: <1!P(1!P(L),1!P(L))>
 
 
 
@@ -15,7 +15,7 @@ Foo.g: 1
 
 ==================== Strictness signatures ====================
 Foo.$trModule:
-Foo.f: <1!P(1L)><1!L><1!L>
-Foo.g: <1!P(1!L,1!L)>
+Foo.f: <1!P(1L)><1!P(L)><1!P(L)>
+Foo.g: <1!P(1!P(L),1!P(L))>
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T15056.stderr b/testsuite/tests/simplCore/should_compile/T15056.stderr
index 1ca9102d70..126bc10057 100644
--- a/testsuite/tests/simplCore/should_compile/T15056.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15056.stderr
@@ -2,9 +2,7 @@ Rule fired: Class op - (BUILTIN)
 Rule fired: Class op + (BUILTIN)
 Rule fired: Class op + (BUILTIN)
 Rule fired: Class op + (BUILTIN)
-Rule fired: Class op enumFromTo (BUILTIN)
-Rule fired: Class op foldr (BUILTIN)
-Rule fired: Class op foldr (BUILTIN)
 Rule fired: +# (BUILTIN)
 Rule fired: Class op foldr (BUILTIN)
+Rule fired: Class op enumFromTo (BUILTIN)
 Rule fired: fold/build (GHC.Base)
diff --git a/testsuite/tests/simplCore/should_compile/T20103.stderr b/testsuite/tests/simplCore/should_compile/T20103.stderr
index f89fe3a8f0..7eea0f5fde 100644
--- a/testsuite/tests/simplCore/should_compile/T20103.stderr
+++ b/testsuite/tests/simplCore/should_compile/T20103.stderr
@@ -11,7 +11,7 @@ lvl = GHC.Types.I# 28#
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl1 :: Int
 [GblId, Unf=OtherCon []]
-lvl1 = GHC.Types.I# 8#
+lvl1 = GHC.Types.I# 7#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl2 :: Int
@@ -75,7 +75,7 @@ lvl10 = GHC.Types.I# 12#
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl11 :: Int
 [GblId, Unf=OtherCon []]
-lvl11 = GHC.Types.I# 7#
+lvl11 = GHC.Types.I# 8#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl12 :: Int
@@ -100,7 +100,7 @@ lvl15 = GHC.CString.unpackCString# lvl14
 
 -- RHS size: {terms: 6, types: 5, coercions: 4, joins: 0/0}
 lvl16 :: CallStack -> ([Char], SrcLoc)
-[GblId, Arity=1, Str=<S>b, Cpr=b, Unf=OtherCon []]
+[GblId, Arity=1, Str=<S!S>b, Cpr=b, Unf=OtherCon []]
 lvl16
   = \ (wild1 :: CallStack) ->
       GHC.List.head1
@@ -115,7 +115,7 @@ T20103.$wfoo [InlPrag=[2], Occ=LoopBreaker]
   :: HasCallStack => GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId[StrictWorker([!, ~])],
  Arity=2,
- Str=<1L><1L>,
+ Str=<SL><1L>,
  Unf=OtherCon []]
 T20103.$wfoo
   = \ ($dIP
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index c63beeca95..dde2503f31 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -65,7 +65,7 @@ T3772.$wfoo
 foo [InlPrag=[final]] :: Int -> ()
 [GblId,
  Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
  Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index b8d14764ce..413f892942 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -56,7 +56,7 @@ end Rec }
 foo [InlPrag=[2]] :: Int -> Int
 [GblId,
  Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
  Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 6ecc7340a2..7b99cc01ff 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -147,7 +147,7 @@ Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2
 foo :: Int -> Int
 [GblId,
  Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
  Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,