DmdAnal: Implement Boxity Analysis (#19871)

This patch fixes some abundant reboxing of `DynFlags` in
`GHC.HsToCore.Match.Literal.warnAboutOverflowedLit` (which was the topic
of #19407) by introducing a Boxity analysis to GHC, done as part of demand
analysis. This allows to accurately capture ad-hoc unboxing decisions previously
made in worker/wrapper in demand analysis now, where the boxity info can
propagate through demand signatures.

See the new `Note [Boxity analysis]`. The actual fix for #19407 is described in
`Note [No lazy, Unboxed demand in demand signature]`, but
`Note [Finalising boxity for demand signature]` is probably a better entry-point.

To support the fix for #19407, I had to change (what was)
`Note [Add demands for strict constructors]` a bit
(now `Note [Unboxing evaluated arguments]`). In particular, we now take care of
it in `finaliseBoxity` (which is only called from demand analaysis) instead of
`wantToUnboxArg`.

I also had to resurrect `Note [Product demands for function body]` and rename
it to `Note [Unboxed demand on function bodies returning small products]` to
avoid huge regressions in `join004` and `join007`, thereby fixing #4267 again.
See the updated Note for details.

A nice side-effect is that the worker/wrapper transformation no longer needs to
look at strictness info and other bits such as `InsideInlineableFun` flags
(needed for `Note [Do not unbox class dictionaries]`) at all. It simply collects
boxity info from argument demands and interprets them with a severely simplified
`wantToUnboxArg`. All the smartness is in `finaliseBoxity`, which could be moved
to DmdAnal completely, if it wasn't for the call to `dubiousDataConInstArgTys`
which would be awkward to export.

I spent some time figuring out the reason for why `T16197` failed prior to my
amendments to `Note [Unboxing evaluated arguments]`. After having it figured
out, I minimised it a bit and added `T16197b`, which simply compares computed
strictness signatures and thus should be far simpler to eyeball.

The 12% ghc/alloc regression in T11545 is because of the additional `Boxity`
field in `Poly` and `Prod` that results in more allocation during `lubSubDmd`
and `plusSubDmd`. I made sure in the ticky profiles that the number of calls
to those functions stayed the same. We can bear such an increase here, as we
recently improved it by -68% (in b760c1f).
T18698* regress slightly because there is more unboxing of dictionaries
happening and that causes Lint (mostly) to allocate more.

Fixes #19871, #19407, #4267, #16859, #18907 and #13331.

Metric Increase:
    T11545
    T18698a
    T18698b

Metric Decrease:
    T12425
    T16577
    T18223
    T18282
    T4267
    T9961

4 files changed, 27 insertions, 31 deletions

diff --git a/testsuite/tests/arityanal/should_compile/Arity04.stderr b/testsuite/tests/arityanal/should_compile/Arity04.stderr
index d2f6457a03..2adcacff39 100644
--- a/testsuite/tests/arityanal/should_compile/Arity04.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity04.stderr
@@ -6,8 +6,8 @@ Result size of Tidy Core = {terms: 39, types: 24, coercions: 0, joins: 0/0}
 f4g :: Int -> Int
 [GblId,
  Arity=1,
- Str=<1P(L)>,
- Cpr=m1,
+ Str=<1!P(L)>,
+ Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (y [Occ=Once1!] :: Int) -> case y of { GHC.Types.I# x [Occ=Once1] -> GHC.Types.I# (GHC.Prim.+# x 1#) }}]
 f4g = \ (y :: Int) -> case y of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }
@@ -22,10 +22,10 @@ Rec {
 F4.$wf4h [InlPrag=[2], Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int
 [GblId, Arity=2, Str=<1C1(L)><1L>, Unf=OtherCon []]
 F4.$wf4h
-  = \ (w :: Int -> Int) (ww :: GHC.Prim.Int#) ->
+  = \ (f :: Int -> Int) (ww :: GHC.Prim.Int#) ->
       case ww of wild {
-        __DEFAULT -> F4.$wf4h w (GHC.Prim.-# wild 1#);
-        0# -> w lvl
+        __DEFAULT -> F4.$wf4h f (GHC.Prim.-# wild 1#);
+        0# -> f lvl
       }
 end Rec }
 
@@ -33,10 +33,10 @@ end Rec }
 f4h [InlPrag=[2]] :: (Int -> Int) -> Int -> Int
 [GblId,
  Arity=2,
- Str=<1C1(L)><1P(1L)>,
+ Str=<1C1(L)><1!P(1L)>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1] :: Int -> Int) (w1 [Occ=Once1!] :: Int) -> case w1 of { GHC.Types.I# ww1 [Occ=Once1] -> F4.$wf4h w ww1 }}]
-f4h = \ (w :: Int -> Int) (w1 :: Int) -> case w1 of { GHC.Types.I# ww1 -> F4.$wf4h w ww1 }
+         Tmpl= \ (f [Occ=Once1] :: Int -> Int) (x [Occ=Once1!] :: Int) -> case x of { GHC.Types.I# ww [Occ=Once1] -> F4.$wf4h f ww }}]
+f4h = \ (f :: Int -> Int) (x :: Int) -> case x of { GHC.Types.I# ww -> F4.$wf4h f ww }
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 f4 :: Int
diff --git a/testsuite/tests/arityanal/should_compile/Arity11.stderr b/testsuite/tests/arityanal/should_compile/Arity11.stderr
index da35b40ab8..48b37a13db 100644
--- a/testsuite/tests/arityanal/should_compile/Arity11.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity11.stderr
@@ -73,7 +73,7 @@ F11.$wfib
 fib [InlPrag=[2]] :: forall {t} {a}. (Eq t, Num t, Num a) => t -> a
 [GblId,
  Arity=4,
- Str=<1P(SCS(C1(L)),A)><LP(A,LCL(C1(L)),A,A,A,A,L)><LP(LCL(C1(L)),A,A,A,A,A,L)><L>,
+ Str=<1!P(SCS(C1(L)),A)><LP(A,LCL(C1(L)),A,A,A,A,L)><LP(LCL(C1(L)),A,A,A,A,A,L)><L>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@t) (@a) (w [Occ=Once1!] :: Eq t) (w1 [Occ=Once1] :: Num t) (w2 [Occ=Once1] :: Num a) (w3 [Occ=Once1] :: t) -> case w of { GHC.Classes.C:Eq ww [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @t @a ww w1 w2 w3 }}]
 fib = \ (@t) (@a) (w :: Eq t) (w1 :: Num t) (w2 :: Num a) (w3 :: t) -> case w of { GHC.Classes.C:Eq ww ww1 -> F11.$wfib @t @a ww w1 w2 w3 }
diff --git a/testsuite/tests/arityanal/should_compile/Arity14.stderr b/testsuite/tests/arityanal/should_compile/Arity14.stderr
index ee54686a29..efd90363c6 100644
--- a/testsuite/tests/arityanal/should_compile/Arity14.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity14.stderr
@@ -41,7 +41,7 @@ F14.$wf14
 f14 [InlPrag=[2]] :: forall {t}. (Ord t, Num t) => t -> t -> t -> t
 [GblId,
  Arity=4,
- Str=<1P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(LCL(C1(L)),A,A,A,A,A,L)><L><L>,
+ Str=<1!P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(LCL(C1(L)),A,A,A,A,A,L)><L><L>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@t) (w [Occ=Once1!] :: Ord t) (w1 [Occ=Once1] :: Num t) (w2 [Occ=Once1] :: t) (w3 [Occ=Once1] :: t) -> case w of { GHC.Classes.C:Ord _ [Occ=Dead] _ [Occ=Dead] ww2 [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] -> F14.$wf14 @t ww2 w1 w2 w3 }}]
 f14 = \ (@t) (w :: Ord t) (w1 :: Num t) (w2 :: t) (w3 :: t) -> case w of { GHC.Classes.C:Ord ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 -> F14.$wf14 @t ww2 w1 w2 w3 }
diff --git a/testsuite/tests/arityanal/should_compile/T18793.stderr b/testsuite/tests/arityanal/should_compile/T18793.stderr
index 6ea36558be..39ce9b9a54 100644
--- a/testsuite/tests/arityanal/should_compile/T18793.stderr
+++ b/testsuite/tests/arityanal/should_compile/T18793.stderr
@@ -1,28 +1,19 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 66, types: 43, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 64, types: 40, coercions: 0, joins: 0/0}
 
--- RHS size: {terms: 15, types: 5, coercions: 0, joins: 0/0}
-T18793.$wstuff [InlPrag=NOINLINE] :: GHC.Prim.Int# -> [Int]
-[GblId, Arity=1, Str=<L>, Unf=OtherCon []]
-T18793.$wstuff = \ (ww :: GHC.Prim.Int#) -> GHC.Types.: @Int (GHC.Types.I# ww) (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ww 1#)) (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ww 2#)) (GHC.Types.[] @Int)))
-
--- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-stuff [InlPrag=[final]] :: Int -> [Int]
-[GblId,
- Arity=1,
- Str=<1P(L)>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww [Occ=Once1] -> T18793.$wstuff ww }}]
-stuff = \ (w :: Int) -> case w of { GHC.Types.I# ww -> T18793.$wstuff ww }
+-- RHS size: {terms: 17, types: 7, coercions: 0, joins: 0/0}
+stuff [InlPrag=NOINLINE] :: Int -> [Int]
+[GblId, Arity=1, Str=<1L>, Unf=OtherCon []]
+stuff = \ (i :: Int) -> case i of i1 { GHC.Types.I# ipv -> GHC.Types.: @Int i1 (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ipv 1#)) (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ipv 2#)) (GHC.Types.[] @Int))) }
 
 Rec {
 -- RHS size: {terms: 23, types: 11, coercions: 0, joins: 0/0}
 T18793.$wgo1 [InlPrag=[2], Occ=LoopBreaker] :: [Int] -> GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId, Arity=2, Str=<1L><L>, Unf=OtherCon []]
 T18793.$wgo1
-  = \ (w :: [Int]) (ww :: GHC.Prim.Int#) ->
-      case w of {
+  = \ (ds :: [Int]) (ww :: GHC.Prim.Int#) ->
+      case ds of {
         [] -> ww;
         : y ys ->
           case y of { GHC.Types.I# x ->
@@ -38,20 +29,25 @@ end Rec }
 T18793.f_go1 [InlPrag=[2]] :: [Int] -> Int -> Int
 [GblId,
  Arity=2,
- Str=<1L><1P(L)>,
+ Str=<1L><1!L>,
  Cpr=1,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once1] :: [Int]) (w1 [Occ=Once1!] :: Int) -> case w1 of { GHC.Types.I# ww [Occ=Once1] -> case T18793.$wgo1 w ww of ww1 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww1 } }}]
-T18793.f_go1 = \ (w :: [Int]) (w1 :: Int) -> case w1 of { GHC.Types.I# ww -> case T18793.$wgo1 w ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } }
+         Tmpl= \ (ds [Occ=Once1] :: [Int]) (eta [Occ=Once1!] :: Int) -> case eta of { GHC.Types.I# ww [Occ=Once1] -> case T18793.$wgo1 ds ww of ww1 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww1 } }}]
+T18793.f_go1 = \ (ds :: [Int]) (eta :: Int) -> case eta of { GHC.Types.I# ww -> case T18793.$wgo1 ds ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } }
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18793.f2 :: Int
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18793.f2 = GHC.Types.I# 1#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T18793.f1 :: [Int]
 [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}]
-T18793.f1 = T18793.$wstuff 1#
+T18793.f1 = stuff T18793.f2
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 f :: Int -> Int
-[GblId, Arity=1, Str=<1P(L)>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
+[GblId, Arity=1, Str=<1!L>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
 f = T18793.f_go1 T18793.f1