Nested CPR light unleashed (#18174)

This patch enables worker/wrapper for nested constructed products, as described
in `Note [Nested CPR]`. The machinery for expressing Nested CPR was already
there, since !5054. Worker/wrapper is equipped to exploit Nested CPR annotations
since !5338. CPR analysis already handles applications in batches since !5753.
This patch just needs to flip a few more switches:

1. In `cprTransformDataConWork`, we need to look at the field expressions
   and their `CprType`s to see whether the evaluation of the expressions
   terminates quickly (= is in HNF) or if they are put in strict fields.
   If that is the case, then we retain their CPR info and may unbox nestedly
   later on. More details in `Note [Nested CPR]`.
2. Enable nested `ConCPR` signatures in `GHC.Types.Cpr`.
3. In the `asConCpr` call in `GHC.Core.Opt.WorkWrap.Utils`, pass CPR info of
   fields to the `Unbox`.
4. Instead of giving CPR signatures to DataCon workers and wrappers, we now have
   `cprTransformDataConWork` for workers and treat wrappers by analysing their
   unfolding. As a result, the code from GHC.Types.Id.Make went away completely.
5. I deactivated worker/wrappering for recursive DataCons and wrote a function
   `isRecDataCon` to detect them. We really don't want to give `repeat` or
   `replicate` the Nested CPR property.
   See Note [CPR for recursive data structures] for which kind of recursive
   DataCons we target.
6. Fix a couple of tests and their outputs.

I also documented that CPR can destroy sharing and lead to asymptotic increase
in allocations (which is tracked by #13331/#19326) in
`Note [CPR for data structures can destroy sharing]`.

Nofib results:
```
--------------------------------------------------------------------------------
        Program         Allocs    Instrs
--------------------------------------------------------------------------------
   ben-raytrace          -3.1%     -0.4%
   binary-trees          +0.8%     -2.9%
   digits-of-e2          +5.8%     +1.2%
          event          +0.8%     -2.1%
 fannkuch-redux          +0.0%     -1.4%
           fish           0.0%     -1.5%
         gamteb          -1.4%     -0.3%
        mkhprog          +1.4%     +0.8%
     multiplier          +0.0%     -1.9%
            pic          -0.6%     -0.1%
        reptile         -20.9%    -17.8%
      wave4main          +4.8%     +0.4%
           x2n1        -100.0%     -7.6%
--------------------------------------------------------------------------------
            Min         -95.0%    -17.8%
            Max          +5.8%     +1.2%
 Geometric Mean          -2.9%     -0.4%
```
The huge wins in x2n1 (loopy list) and reptile (see #19970) are due to
refraining from unboxing (:). Other benchmarks like digits-of-e2 or wave4main
regress because of that. Ultimately there are no great improvements due to
Nested CPR alone, but at least it's a win.
Binary sizes decrease by 0.6%.

There are a significant number of metric decreases. The most notable ones (>1%):
```
       ManyAlternatives(normal) ghc/alloc   771656002.7   762187472.0  -1.2%
       ManyConstructors(normal) ghc/alloc  4191073418.7  4114369216.0  -1.8%
      MultiLayerModules(normal) ghc/alloc  3095678333.3  3128720704.0  +1.1%
              PmSeriesG(normal) ghc/alloc    50096429.3    51495664.0  +2.8%
              PmSeriesS(normal) ghc/alloc    63512989.3    64681600.0  +1.8%
              PmSeriesV(normal) ghc/alloc    62575424.0    63767208.0  +1.9%
                 T10547(normal) ghc/alloc    29347469.3    29944240.0  +2.0%
                T11303b(normal) ghc/alloc    46018752.0    47367576.0  +2.9%
                 T12150(optasm) ghc/alloc    81660890.7    82547696.0  +1.1%
                 T12234(optasm) ghc/alloc    59451253.3    60357952.0  +1.5%
                 T12545(normal) ghc/alloc  1705216250.7  1751278952.0  +2.7%
                 T12707(normal) ghc/alloc   981000472.0   968489800.0  -1.3% GOOD
                 T13056(optasm) ghc/alloc   389322664.0   372495160.0  -4.3% GOOD
                 T13253(normal) ghc/alloc   337174229.3   341954576.0  +1.4%
                 T13701(normal) ghc/alloc  2381455173.3  2439790328.0  +2.4%  BAD
                   T14052(ghci) ghc/alloc  2162530642.7  2139108784.0  -1.1%
                 T14683(normal) ghc/alloc  3049744728.0  2977535064.0  -2.4% GOOD
                 T14697(normal) ghc/alloc   362980213.3   369304512.0  +1.7%
                 T15164(normal) ghc/alloc  1323102752.0  1307480600.0  -1.2%
                 T15304(normal) ghc/alloc  1304607429.3  1291024568.0  -1.0%
                 T16190(normal) ghc/alloc   281450410.7   284878048.0  +1.2%
                 T16577(normal) ghc/alloc  7984960789.3  7811668768.0  -2.2% GOOD
                 T17516(normal) ghc/alloc  1171051192.0  1153649664.0  -1.5%
                 T17836(normal) ghc/alloc  1115569746.7  1098197592.0  -1.6%
                T17836b(normal) ghc/alloc    54322597.3    55518216.0  +2.2%
                 T17977(normal) ghc/alloc    47071754.7    48403408.0  +2.8%
                T17977b(normal) ghc/alloc    42579133.3    43977392.0  +3.3%
                 T18923(normal) ghc/alloc    71764237.3    72566240.0  +1.1%
                  T1969(normal) ghc/alloc   784821002.7   773971776.0  -1.4% GOOD
                  T3294(normal) ghc/alloc  1634913973.3  1614323584.0  -1.3% GOOD
                  T4801(normal) ghc/alloc   295619648.0   292776440.0  -1.0%
                T5321FD(normal) ghc/alloc   278827858.7   276067280.0  -1.0%
                  T5631(normal) ghc/alloc   586618202.7   577579960.0  -1.5%
                  T5642(normal) ghc/alloc   494923048.0   487927208.0  -1.4%
                  T5837(normal) ghc/alloc    37758061.3    39261608.0  +4.0%
                  T9020(optasm) ghc/alloc   257362077.3   254672416.0  -1.0%
                  T9198(normal) ghc/alloc    49313365.3    50603936.0  +2.6%  BAD
                  T9233(normal) ghc/alloc   704944258.7   685692712.0  -2.7% GOOD
                  T9630(normal) ghc/alloc  1476621560.0  1455192784.0  -1.5%
                  T9675(optasm) ghc/alloc   443183173.3   433859696.0  -2.1% GOOD
                 T9872a(normal) ghc/alloc  1720926653.3  1693190072.0  -1.6% GOOD
                 T9872b(normal) ghc/alloc  2185618061.3  2162277568.0  -1.1% GOOD
                 T9872c(normal) ghc/alloc  1765842405.3  1733618088.0  -1.8% GOOD
   TcPlugin_RewritePerf(normal) ghc/alloc  2388882730.7  2365504696.0  -1.0%
                  WWRec(normal) ghc/alloc   607073186.7   597512216.0  -1.6%

                  T9203(normal) run/alloc   107284064.0   102881832.0  -4.1%
          haddock.Cabal(normal) run/alloc 24025329589.3 23768382560.0  -1.1%
           haddock.base(normal) run/alloc 25660521653.3 25370321824.0  -1.1%
       haddock.compiler(normal) run/alloc 74064171706.7 73358712280.0  -1.0%
```
The biggest exception to the rule is T13701 which seems to fluctuate as usual
(not unlike T12545). T14697 has a similar quality, being a generated
multi-module test. T5837 is small enough that it similarly doesn't measure
anything significant besides module loading overhead.
T13253 simply does one additional round of Simplification due to Nested CPR.

There are also some apparent regressions in T9198, T12234 and PmSeriesG that we
(@mpickering and I) were simply unable to reproduce locally. @mpickering tried
to run the CI script in a local Docker container and actually found that T9198
and PmSeriesG *improved*. In MRs that were rebased on top this one, like !4229,
I did not experience such increases. Let's not get hung up on these regression
tests, they were meant to test for asymptotic regressions.

The build-cabal test improves by 1.2% in -O0.

Metric Increase:
    T10421
    T12234
    T12545
    T13035
    T13056
    T13701
    T14697
    T18923
    T5837
    T9198
Metric Decrease:
    ManyConstructors
    T12545
    T12707
    T13056
    T14683
    T16577
    T18223
    T1969
    T3294
    T9203
    T9233
    T9675
    T9872a
    T9872b
    T9872c
    T9961
    TcPlugin_RewritePerf

11 files changed, 522 insertions, 21 deletions

diff --git a/testsuite/tests/cpranal/should_compile/T18174.hs b/testsuite/tests/cpranal/should_compile/T18174.hs
new file mode 100644
index 0000000000..bf1c02982c
--- /dev/null
+++ b/testsuite/tests/cpranal/should_compile/T18174.hs
@@ -0,0 +1,92 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+{-# LANGUAGE BangPatterns #-}
+
+module T18174 (fac1, fac2, fac3, facIO, dataConWrapper, strictField, thunkDiverges, h1, h2) where
+
+----------------------------------------------------------------------
+-- First some basic examples that we want to CPR nestedly for the Int.
+
+-- pretty strict
+fac1 :: Int -> a ->  (a, Int)
+fac1 n s | n < 2     = (s,1)
+         | otherwise = case  fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'')
+
+-- lazier, but Int still would be fine to have CPR.
+-- !1866 catches it, but Nested CPR light does not.
+fac2 :: Int -> a ->  (a, Int)
+fac2 n s | n < 2     = (s,1)
+         | otherwise = case  fac2 (n-1) s of (s',n') -> (s',n'*n')
+
+-- even lazier, but evaluation of the Int doesn't terminate rapidly!
+-- Thus, we may not WW for the nested Int.
+-- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly)
+-- evaluates more than necessary.
+fac3 :: Int -> a ->  (a, Int)
+fac3 n s | n < 2     = (s,1)
+         | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n')
+
+-- This one is like face2.
+-- !1866 manages to unbox the Int, but Nested CPR does not.
+facIO :: Int -> IO Int
+facIO n | n < 2     = return 1
+        | otherwise = do n' <- facIO (n-1); return (n*n')
+
+-- Now some checks wrt. strict fields where we don't want to unbox.
+
+data T = MkT Int !(Int, Int)
+
+-- | Should not unbox any component, because the wrapper of 'MkT' forces
+-- 'p', which this function is lazy in. Similarly for 'x'.
+dataConWrapper :: (Int, Int) -> Int -> (T, Int)
+dataConWrapper p x = (MkT x p, x+1)
+{-# NOINLINE dataConWrapper #-}
+
+-- | Should not unbox the second component, because 'x' won't be available
+-- unboxed. It terminates, though.
+strictField :: T -> (Int, (Int, Int))
+strictField (MkT x y) = (x, y)
+{-# NOINLINE strictField #-}
+
+-- | Should not unbox the first component, because 'x' might not terminate.
+thunkDiverges :: Int -> (Int, Bool)
+thunkDiverges x = (let t = x+1 in t+t, False)
+
+----------------------------------------------------------------------
+-- The following functions are copied from T18894. This test is about
+-- *exploiting* the demand signatures that we assertedly (by T18894)
+-- annotate.
+
+g1 :: Int -> (Int,Int)
+g1 1 = (15, 0)
+g1 n = (2 * n, 2 `div` n)
+{-# NOINLINE g1 #-}
+
+-- | Sadly, the @g1 2@ subexpression will be floated to top-level, where we
+-- don't see the specific demand placed on it by @snd@. Tracked in #19001.
+h1 :: Int -> Int
+h1 1 = 0
+h1 2 = snd (g1 2)
+h1 m = uncurry (+) (g1 m)
+
+-- | So @g2@ here takes an additional argument m that prohibits floating to
+-- top-level. We want that argument to have the CPR property, so we have
+-- to add a bang so that it's used strictly and ultimately unboxed.
+-- We expect the following CPR type (in the form of !1866:
+--
+-- > #c1(#c1(#), *c1(#))
+--
+-- In combination with the the fact that all calls to @g2@ evaluate the second
+-- component of the pair, we may unbox @g2@ to @(# Int#, Int# #)@.
+--
+-- Nested CPR light doesn't manage to unbox the second component, though.
+g2 :: Int -> Int -> (Int,Int)
+g2 !m 1 = (2 + m, 0)
+g2 m  n = (2 * m, 2 `div` n)
+{-# NOINLINE g2 #-}
+
+-- !1866 manages to give it CPR, Nested CPR light doesn't.
+h2 :: Int -> Int
+h2 1 = 0
+h2 m
+  | odd m     = snd (g2 m 2)
+  | otherwise = uncurry (+) (g2 2 m)
diff --git a/testsuite/tests/cpranal/should_compile/T18174.stderr b/testsuite/tests/cpranal/should_compile/T18174.stderr
new file mode 100644
index 0000000000..b251d9914a
--- /dev/null
+++ b/testsuite/tests/cpranal/should_compile/T18174.stderr
@@ -0,0 +1,254 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 464, types: 475, coercions: 6, joins: 0/3}
+
+-- RHS size: {terms: 8, types: 7, coercions: 0, joins: 0/0}
+T18174.$WMkT :: Int %1 -> (Int, Int) %1 -> T
+T18174.$WMkT = \ (conrep_aU0 :: Int) (conrep_aU1 :: (Int, Int)) -> case conrep_aU1 of conrep_X0 { __DEFAULT -> T18174.MkT conrep_aU0 conrep_X0 }
+
+-- RHS size: {terms: 5, types: 10, coercions: 0, joins: 0/0}
+T18174.$wstrictField :: Int -> (Int, Int) -> (# Int, (Int, Int) #)
+T18174.$wstrictField
+  = \ (ww_s18W :: Int)
+      (ww1_s18X
+         :: (Int, Int)
+         Unf=OtherCon []) ->
+      (# ww_s18W, ww1_s18X #)
+
+-- RHS size: {terms: 12, types: 21, coercions: 0, joins: 0/0}
+strictField :: T -> (Int, (Int, Int))
+strictField = \ (ds_s18U :: T) -> case ds_s18U of { MkT ww_s18W ww1_s18X -> case T18174.$wstrictField ww_s18W ww1_s18X of { (# ww2_s1aJ, ww3_s1aK #) -> (ww2_s1aJ, ww3_s1aK) } }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18174.$trModule4 :: GHC.Prim.Addr#
+T18174.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18174.$trModule3 :: GHC.Types.TrName
+T18174.$trModule3 = GHC.Types.TrNameS T18174.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18174.$trModule2 :: GHC.Prim.Addr#
+T18174.$trModule2 = "T18174"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18174.$trModule1 :: GHC.Types.TrName
+T18174.$trModule1 = GHC.Types.TrNameS T18174.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T18174.$trModule :: GHC.Types.Module
+T18174.$trModule = GHC.Types.Module T18174.$trModule3 T18174.$trModule1
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep_r1c2 :: GHC.Types.KindRep
+$krep_r1c2 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep1_r1c3 :: [GHC.Types.KindRep]
+$krep1_r1c3 = GHC.Types.: @GHC.Types.KindRep $krep_r1c2 (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep2_r1c4 :: [GHC.Types.KindRep]
+$krep2_r1c4 = GHC.Types.: @GHC.Types.KindRep $krep_r1c2 $krep1_r1c3
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep3_r1c5 :: GHC.Types.KindRep
+$krep3_r1c5 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep2_r1c4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18174.$tcT2 :: GHC.Prim.Addr#
+T18174.$tcT2 = "T"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18174.$tcT1 :: GHC.Types.TrName
+T18174.$tcT1 = GHC.Types.TrNameS T18174.$tcT2
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T18174.$tcT :: GHC.Types.TyCon
+T18174.$tcT = GHC.Types.TyCon 10767449832801551323## 11558512111670031614## T18174.$trModule T18174.$tcT1 0# GHC.Types.krep$*
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep4_r1c6 :: GHC.Types.KindRep
+$krep4_r1c6 = GHC.Types.KindRepTyConApp T18174.$tcT (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep5_r1c7 :: GHC.Types.KindRep
+$krep5_r1c7 = GHC.Types.KindRepFun $krep3_r1c5 $krep4_r1c6
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T18174.$tc'MkT1 :: GHC.Types.KindRep
+T18174.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1c2 $krep5_r1c7
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18174.$tc'MkT3 :: GHC.Prim.Addr#
+T18174.$tc'MkT3 = "'MkT"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18174.$tc'MkT2 :: GHC.Types.TrName
+T18174.$tc'MkT2 = GHC.Types.TrNameS T18174.$tc'MkT3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T18174.$tc'MkT :: GHC.Types.TyCon
+T18174.$tc'MkT = GHC.Types.TyCon 15126196523434762667## 13148007393547580468## T18174.$trModule T18174.$tc'MkT2 0# T18174.$tc'MkT1
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_r1c8 :: Int
+lvl_r1c8 = GHC.Types.I# 1#
+
+Rec {
+-- RHS size: {terms: 38, types: 38, coercions: 0, joins: 0/1}
+T18174.$wfac3 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #)
+T18174.$wfac3
+  = \ (@a_s196) (ww_s199 :: GHC.Prim.Int#) (s_s19b :: a_s196) ->
+      case GHC.Prim.<# ww_s199 2# of {
+        __DEFAULT ->
+          let {
+            ds_s18k :: (a_s196, Int)
+            ds_s18k = case T18174.$wfac3 @a_s196 (GHC.Prim.-# ww_s199 1#) s_s19b of { (# ww1_s1aM, ww2_s1aN #) -> (ww1_s1aM, ww2_s1aN) } } in
+          (# case ds_s18k of { (s'_aYW, n'_aYX) -> s'_aYW }, case ds_s18k of { (s'_aYW, n'_aYX) -> case n'_aYX of { GHC.Types.I# ww1_s193 -> GHC.Types.I# (GHC.Prim.*# ww1_s193 ww1_s193) } } #);
+        1# -> (# s_s19b, lvl_r1c8 #)
+      }
+end Rec }
+
+-- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0}
+fac3 :: forall a. Int -> a -> (a, Int)
+fac3 = \ (@a_s196) (n_s197 :: Int) (s_s19b :: a_s196) -> case n_s197 of { GHC.Types.I# ww_s199 -> case T18174.$wfac3 @a_s196 ww_s199 s_s19b of { (# ww1_s1aM, ww2_s1aN #) -> (ww1_s1aM, ww2_s1aN) } }
+
+Rec {
+-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0}
+T18174.$wfac2 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #)
+T18174.$wfac2
+  = \ (@a_s19g) (ww_s19j :: GHC.Prim.Int#) (s_s19l :: a_s19g) ->
+      case GHC.Prim.<# ww_s19j 2# of {
+        __DEFAULT -> case T18174.$wfac2 @a_s19g (GHC.Prim.-# ww_s19j 1#) s_s19l of { (# ww1_s1aP, ww2_s1aQ #) -> (# ww1_s1aP, GHC.Num.$fNumInt_$c* ww2_s1aQ ww2_s1aQ #) };
+        1# -> (# s_s19l, lvl_r1c8 #)
+      }
+end Rec }
+
+-- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0}
+fac2 :: forall a. Int -> a -> (a, Int)
+fac2 = \ (@a_s19g) (n_s19h :: Int) (s_s19l :: a_s19g) -> case n_s19h of { GHC.Types.I# ww_s19j -> case T18174.$wfac2 @a_s19g ww_s19j s_s19l of { (# ww1_s1aP, ww2_s1aQ #) -> (ww1_s1aP, ww2_s1aQ) } }
+
+Rec {
+-- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0}
+T18174.$wfac1 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #)
+T18174.$wfac1
+  = \ (@a_s19q) (ww_s19t :: GHC.Prim.Int#) (s_s19v :: a_s19q) ->
+      case GHC.Prim.<# ww_s19t 2# of {
+        __DEFAULT -> case T18174.$wfac1 @a_s19q (GHC.Prim.-# ww_s19t 1#) s_s19v of { (# ww1_s19y, ww2_s1aS #) -> (# ww1_s19y, GHC.Prim.*# ww_s19t ww2_s1aS #) };
+        1# -> (# s_s19v, 1# #)
+      }
+end Rec }
+
+-- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0}
+fac1 :: forall a. Int -> a -> (a, Int)
+fac1 = \ (@a_s19q) (n_s19r :: Int) (s_s19v :: a_s19q) -> case n_s19r of { GHC.Types.I# ww_s19t -> case T18174.$wfac1 @a_s19q ww_s19t s_s19v of { (# ww1_s19y, ww2_s1aS #) -> (ww1_s19y, GHC.Types.I# ww2_s1aS) } }
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18174.h5 :: Int
+T18174.h5 = GHC.Types.I# 0#
+
+-- RHS size: {terms: 37, types: 15, coercions: 0, joins: 0/1}
+T18174.$wg2 :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #)
+T18174.$wg2
+  = \ (ww_s19G :: GHC.Prim.Int#) (ww1_s19K :: GHC.Prim.Int#) ->
+      case ww1_s19K of ds_X2 {
+        __DEFAULT ->
+          (# GHC.Prim.*# 2# ww_s19G,
+             case ds_X2 of wild_X3 {
+               __DEFAULT ->
+                 let {
+                   c1#_a17n :: GHC.Prim.Int#
+                   c1#_a17n = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in
+                 case GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a17n) wild_X3 of wild1_a17o { __DEFAULT -> GHC.Types.I# (GHC.Prim.-# wild1_a17o c1#_a17n) };
+               0# -> GHC.Real.divZeroError @Int
+             } #);
+        1# -> (# GHC.Prim.+# 2# ww_s19G, T18174.h5 #)
+      }
+
+-- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0}
+T18174.$wh2 :: GHC.Prim.Int# -> Int
+T18174.$wh2
+  = \ (ww_s19W :: GHC.Prim.Int#) ->
+      case ww_s19W of ds_X2 {
+        __DEFAULT ->
+          case GHC.Prim.remInt# ds_X2 2# of {
+            __DEFAULT -> case T18174.$wg2 ds_X2 2# of { (# ww1_s1aU, ww2_s19Q #) -> ww2_s19Q };
+            0# -> case T18174.$wg2 2# ds_X2 of { (# ww1_s1aU, ww2_s19Q #) -> case ww2_s19Q of { GHC.Types.I# y_a17v -> GHC.Types.I# (GHC.Prim.+# ww1_s1aU y_a17v) } }
+          };
+        1# -> T18174.h5
+      }
+
+-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
+h2 :: Int -> Int
+h2 = \ (ds_s19U :: Int) -> case ds_s19U of { GHC.Types.I# ww_s19W -> T18174.$wh2 ww_s19W }
+
+-- RHS size: {terms: 34, types: 14, coercions: 0, joins: 0/1}
+T18174.$wg1 :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #)
+T18174.$wg1
+  = \ (ww_s1a3 :: GHC.Prim.Int#) ->
+      case ww_s1a3 of ds_X2 {
+        __DEFAULT ->
+          (# GHC.Prim.*# 2# ds_X2,
+             case ds_X2 of wild_X3 {
+               __DEFAULT ->
+                 let {
+                   c1#_a17n :: GHC.Prim.Int#
+                   c1#_a17n = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in
+                 case GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a17n) wild_X3 of wild1_a17o { __DEFAULT -> GHC.Types.I# (GHC.Prim.-# wild1_a17o c1#_a17n) };
+               0# -> GHC.Real.divZeroError @Int
+             } #);
+        1# -> (# 15#, T18174.h5 #)
+      }
+
+-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0}
+T18174.h4 :: (Int, Int)
+T18174.h4 = case T18174.$wg1 2# of { (# ww_s1aW, ww1_s1a9 #) -> (GHC.Types.I# ww_s1aW, ww1_s1a9) }
+
+-- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0}
+T18174.$wh1 :: GHC.Prim.Int# -> Int
+T18174.$wh1
+  = \ (ww_s1af :: GHC.Prim.Int#) ->
+      case ww_s1af of ds_X2 {
+        __DEFAULT -> case T18174.$wg1 ds_X2 of { (# ww1_s1aW, ww2_s1a9 #) -> case ww2_s1a9 of { GHC.Types.I# y_a17v -> GHC.Types.I# (GHC.Prim.+# ww1_s1aW y_a17v) } };
+        1# -> T18174.h5;
+        2# -> case T18174.h4 of { (ds1_a155, y_a156) -> y_a156 }
+      }
+
+-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
+h1 :: Int -> Int
+h1 = \ (ds_s1ad :: Int) -> case ds_s1ad of { GHC.Types.I# ww_s1af -> T18174.$wh1 ww_s1af }
+
+-- RHS size: {terms: 12, types: 5, coercions: 0, joins: 0/0}
+thunkDiverges :: Int -> (Int, Bool)
+thunkDiverges = \ (x_aIy :: Int) -> (case x_aIy of { GHC.Types.I# x1_a17s -> GHC.Types.I# (GHC.Prim.+# 2# (GHC.Prim.*# 2# x1_a17s)) }, GHC.Types.False)
+
+-- RHS size: {terms: 13, types: 10, coercions: 0, joins: 0/0}
+T18174.$wdataConWrapper :: (Int, Int) -> Int -> (# T, Int #)
+T18174.$wdataConWrapper = \ (p_s1av :: (Int, Int)) (x_s1aw :: Int) -> (# T18174.$WMkT x_s1aw p_s1av, case x_s1aw of { GHC.Types.I# x1_a17s -> GHC.Types.I# (GHC.Prim.+# x1_a17s 1#) } #)
+
+-- RHS size: {terms: 10, types: 13, coercions: 0, joins: 0/0}
+dataConWrapper :: (Int, Int) -> Int -> (T, Int)
+dataConWrapper = \ (p_s1av :: (Int, Int)) (x_s1aw :: Int) -> case T18174.$wdataConWrapper p_s1av x_s1aw of { (# ww_s1aY, ww1_s1aZ #) -> (ww_s1aY, ww1_s1aZ) }
+
+Rec {
+-- RHS size: {terms: 27, types: 31, coercions: 0, joins: 0/0}
+T18174.$wfacIO :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
+T18174.$wfacIO
+  = \ (ww_s1aD :: GHC.Prim.Int#) (eta_s1aF :: GHC.Prim.State# GHC.Prim.RealWorld) ->
+      case GHC.Prim.<# ww_s1aD 2# of {
+        __DEFAULT -> case T18174.$wfacIO (GHC.Prim.-# ww_s1aD 1#) eta_s1aF of { (# ipv_a180, ipv1_a181 #) -> (# ipv_a180, case ipv1_a181 of { GHC.Types.I# y_a16I -> GHC.Types.I# (GHC.Prim.*# ww_s1aD y_a16I) } #) };
+        1# -> (# eta_s1aF, lvl_r1c8 #)
+      }
+end Rec }
+
+-- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0}
+T18174.facIO1 :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
+T18174.facIO1 = \ (n_s1aB :: Int) (eta_s1aF :: GHC.Prim.State# GHC.Prim.RealWorld) -> case n_s1aB of { GHC.Types.I# ww_s1aD -> T18174.$wfacIO ww_s1aD eta_s1aF }
+
+-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
+facIO :: Int -> IO Int
+facIO = T18174.facIO1 `cast` (<Int>_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] <Int>_R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))
+
+
+
diff --git a/testsuite/tests/cpranal/should_compile/T18401.stderr b/testsuite/tests/cpranal/should_compile/T18401.stderr
index e299ba4dc7..75913b3979 100644
--- a/testsuite/tests/cpranal/should_compile/T18401.stderr
+++ b/testsuite/tests/cpranal/should_compile/T18401.stderr
@@ -1,34 +1,34 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 54, types: 101, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 52, types: 86, coercions: 0, joins: 0/0}
 
 Rec {
--- RHS size: {terms: 20, types: 31, coercions: 0, joins: 0/0}
-T18401.safeInit_$spoly_$wgo1 :: forall {a}. a -> [a] -> (# Bool, [a] #)
-T18401.safeInit_$spoly_$wgo1
-  = \ (@a_aO1) (sc_s17W :: a_aO1) (sc1_s17V :: [a_aO1]) ->
-      case sc1_s17V of {
-        [] -> (# GHC.Types.True, GHC.Types.[] @a_aO1 #);
-        : y_a158 ys_a159 -> (# GHC.Types.True, GHC.Types.: @a_aO1 sc_s17W (case T18401.safeInit_$spoly_$wgo1 @a_aO1 y_a158 ys_a159 of { (# ww_s17y, ww1_s17z #) -> ww1_s17z }) #)
+-- RHS size: {terms: 18, types: 24, coercions: 0, joins: 0/0}
+T18401.$w$spoly_$wgo1 :: forall {a}. a -> [a] -> (# [a] #)
+T18401.$w$spoly_$wgo1
+  = \ (@a_s18C) (w_s18D :: a_s18C) (w1_s18E :: [a_s18C]) ->
+      case w1_s18E of {
+        [] -> (# GHC.Types.[] @a_s18C #);
+        : y_a15b ys_a15c -> (# GHC.Types.: @a_s18C w_s18D (case T18401.$w$spoly_$wgo1 @a_s18C y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J }) #)
       }
 end Rec }
 
--- RHS size: {terms: 17, types: 25, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 17, types: 22, coercions: 0, joins: 0/0}
 si :: forall a. [a] -> (Bool, [a])
 si
-  = \ (@a_s17i) (w_s17j :: [a_s17i]) ->
-      case w_s17j of {
-        [] -> (GHC.Types.False, GHC.Types.[] @a_s17i);
-        : y_a158 ys_a159 -> (GHC.Types.True, case T18401.safeInit_$spoly_$wgo1 @a_s17i y_a158 ys_a159 of { (# ww_X3, ww1_X4 #) -> ww1_X4 })
+  = \ (@a_s17T) (w_s17U :: [a_s17T]) ->
+      case w_s17U of {
+        [] -> (GHC.Types.False, GHC.Types.[] @a_s17T);
+        : y_a15b ys_a15c -> (GHC.Types.True, case T18401.$w$spoly_$wgo1 @a_s17T y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J })
       }
 
--- RHS size: {terms: 14, types: 22, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
 safeInit :: forall a. [a] -> Maybe [a]
 safeInit
-  = \ (@a_aO1) (xs_aus :: [a_aO1]) ->
-      case xs_aus of {
-        [] -> GHC.Maybe.Nothing @[a_aO1];
-        : y_a158 ys_a159 -> GHC.Maybe.Just @[a_aO1] (case T18401.safeInit_$spoly_$wgo1 @a_aO1 y_a158 ys_a159 of { (# ww_X3, ww1_X4 #) -> ww1_X4 })
+  = \ (@a_aPB) (xs_aut :: [a_aPB]) ->
+      case xs_aut of {
+        [] -> GHC.Maybe.Nothing @[a_aPB];
+        : y_a15b ys_a15c -> GHC.Maybe.Just @[a_aPB] (case T18401.$w$spoly_$wgo1 @a_aPB y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J })
       }
 
 
diff --git a/testsuite/tests/cpranal/should_compile/all.T b/testsuite/tests/cpranal/should_compile/all.T
index d70d978be6..570b78228f 100644
--- a/testsuite/tests/cpranal/should_compile/all.T
+++ b/testsuite/tests/cpranal/should_compile/all.T
@@ -7,6 +7,7 @@ setTestOpts(f)
 test('Cpr001', [], multimod_compile, ['Cpr001', '-v0'])
 # The following tests grep for type signatures of worker functions.
 test('T18109', [ grep_errmsg(r'^T18109\.\$w\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999'])
+test('T18174', [ grep_errmsg(r'^T18174\.\$w\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999'])
 # T18401 probably needs -flate-dmd-anal so that it runs after SpecConstr.
 # It is currently broken, but not marked expect_broken. We can't know the exact
 # name of the function before it is fixed, so expect_broken doesn't make sense.
diff --git a/testsuite/tests/cpranal/sigs/RecDataConCPR.hs b/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
new file mode 100644
index 0000000000..c26ae1264f
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
@@ -0,0 +1,117 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Serves as a unit test for isRecDataCon.
+-- See Note [CPR for recursive data constructors] for similar examples.
+module RecDataConCPR where
+
+import Control.Monad.Trans.State
+import Control.Monad.ST
+import Data.Char
+
+import {-# SOURCE #-} RecDataConCPRa
+
+replicateOne :: Int -> [Int]
+replicateOne 1 = [1]
+replicateOne n = 1 : replicateOne (n-1)
+
+data T = T (Int, (Bool, Char)) -- NonRec
+t :: Char -> Bool -> Int -> T
+t a b c = T (c, (b, a))
+
+data U = U [Int] -- NonRec
+
+u :: Int -> U
+u x = U (replicate x 1000)
+
+data U2 = U2 [U2] -- Rec
+
+u2 :: Int -> U2
+u2 x = U2 (replicate 1000 (u2 (x-1)))
+
+data R0 = R0 R1 | R0End Int -- Rec, but out of fuel (and thus considered NonRec)
+data R1 = R1 R2
+data R2 = R2 R3
+data R3 = R3 R4
+data R4 = R4 R5
+data R5 = R5 R6
+data R6 = R6 R7
+data R7 = R7 R8
+data R8 = R8 R9
+data R9 = R9 R0
+
+r :: Bool -> Int -> R0
+r False x = r True x
+r True  x = R0 (R1 (R2 (R3 (R4 (R5 (R6 (R7 (R8 (R9 (R0End x))))))))))
+
+data R20 = R20 R21 | R20End Int -- Rec
+data R21 = R21 R20
+
+r2 :: Bool -> Int -> R20
+r2 False x = r2 True x
+r2 True  x = R20 (R21 (R20End 4))
+
+newtype Fix f = Fix (f (Fix f)) -- Rec
+
+fixx :: Int -> Fix Maybe
+fixx 0 = Fix Nothing
+fixx n = Fix (Just (fixx (n-1)))
+
+data N = N (Fix (Either Int)) -- NonRec
+data M = M (Fix (Either M)) -- Rec
+
+n :: Int -> N
+n = N . go
+  where
+    go 0 = Fix (Left 42)
+    go n = Fix (Right (go (n-1)))
+
+m :: Int -> M
+m = M . go
+  where
+    go 0 = Fix (Left (m 42))
+    go n = Fix (Right (go (n-1)))
+
+data F = F (F -> Int) -- NonRec
+f :: Int -> F
+f n = F (const n)
+
+data G = G (Int -> G) -- NonRec
+g :: Int -> G
+g n = G (\m -> g (n+m))
+
+newtype MyM s a = MyM (StateT Int (ST s) a) -- NonRec
+myM :: Int -> MyM s Int
+myM 0 = MyM $ pure 42
+myM n = myM (n-1)
+
+type S = (Int, Bool) -- NonRec
+s :: Int -> S
+s n = (n, True)
+
+type family E a
+type instance E Int = Char
+type instance E (a,b) = (E a, E b)
+type instance E Char = Blub
+data Blah = Blah (E (Int, (Int, Int))) -- NonRec
+data Blub = Blub (E (Char, Int))       -- Rec
+data Blub2 = Blub2 (E (Bool, Int))       -- Rec, because stuck
+
+blah :: Int -> Blah
+blah n = Blah (chr n, (chr (n+1), chr (n+2)))
+
+blub :: Int -> Blub
+blub n = Blub (blub (n-1), chr n)
+
+blub2 :: Int -> Blub2
+blub2 n = Blub2 (undefined :: E Bool, chr n)
+
+-- Now for abstract TyCons, point (7) of the Note:
+data BootNonRec1 = BootNonRec1 BootNonRec2 -- in RecDataConCPRa.hs-boot
+data BootRec1 = BootRec1 BootRec2 -- in RecDataConCPRa.hs-boot, recurses back
+
+bootNonRec :: Int -> BootNonRec2 -> BootNonRec1 -- Nothing, thus like NonRec
+bootNonRec x b2 = BootNonRec1 b2
+
+bootRec :: Int -> BootRec2 -> BootRec1 -- Nothing, thus like NonRec
+bootRec x b2 = BootRec1 b2
diff --git a/testsuite/tests/cpranal/sigs/RecDataConCPR.stderr b/testsuite/tests/cpranal/sigs/RecDataConCPR.stderr
new file mode 100644
index 0000000000..b330c78da0
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/RecDataConCPR.stderr
@@ -0,0 +1,26 @@
+
+==================== Cpr signatures ====================
+RecDataConCPR.blah: 1(1(, 1))
+RecDataConCPR.blub:
+RecDataConCPR.blub2:
+RecDataConCPR.bootNonRec: 1
+RecDataConCPR.bootRec: 1
+RecDataConCPR.f: 1
+RecDataConCPR.fixx:
+RecDataConCPR.g: 1
+RecDataConCPR.m:
+RecDataConCPR.myM: 1(, 1(1,))
+RecDataConCPR.n: 1
+RecDataConCPR.r: 1(1(1(1(1(1(1(1(1(1(2))))))))))
+RecDataConCPR.r2:
+RecDataConCPR.replicateOne:
+RecDataConCPR.s: 1(, 2)
+RecDataConCPR.t: 1(1(, 1))
+RecDataConCPR.u: 1
+RecDataConCPR.u2:
+
+
+
+==================== Cpr signatures ====================
+
+
diff --git a/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs b/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs
new file mode 100644
index 0000000000..0ebdeb8c53
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs
@@ -0,0 +1,6 @@
+module RecDataConCPRa where
+
+import RecDataConCPR
+
+data BootNonRec2 = BootNonRec2
+data BootRec2 = BootRec2 BootRec1
diff --git a/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs-boot b/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs-boot
new file mode 100644
index 0000000000..35369d1ef6
--- /dev/null
+++ b/testsuite/tests/cpranal/sigs/RecDataConCPRa.hs-boot
@@ -0,0 +1,4 @@
+module RecDataConCPRa where
+
+data BootNonRec2
+data BootRec2
diff --git a/testsuite/tests/cpranal/sigs/T19398.stderr b/testsuite/tests/cpranal/sigs/T19398.stderr
index a293fdd089..faa335d399 100644
--- a/testsuite/tests/cpranal/sigs/T19398.stderr
+++ b/testsuite/tests/cpranal/sigs/T19398.stderr
@@ -3,6 +3,6 @@
 T19398.a:
 T19398.c:
 T19398.f: 1
-T19398.g: 1
+T19398.g: 1(1, 1)
 
 
diff --git a/testsuite/tests/cpranal/sigs/T19822.stderr b/testsuite/tests/cpranal/sigs/T19822.stderr
index 8e4636d322..607e806e8c 100644
--- a/testsuite/tests/cpranal/sigs/T19822.stderr
+++ b/testsuite/tests/cpranal/sigs/T19822.stderr
@@ -1,5 +1,5 @@
 
 ==================== Cpr signatures ====================
-T19822.singleton: 1
+T19822.singleton: 1(, 1)
 
 
diff --git a/testsuite/tests/cpranal/sigs/all.T b/testsuite/tests/cpranal/sigs/all.T
index 99cdebe716..90a6b9e693 100644
--- a/testsuite/tests/cpranal/sigs/all.T
+++ b/testsuite/tests/cpranal/sigs/all.T
@@ -3,9 +3,10 @@
 setTestOpts(only_ways(['optasm']))
 # This directory contains tests where we annotate functions with expected
 # CPR signatures, and verify that these are actually those found by the compiler
-setTestOpts(extra_hc_opts('-dno-typeable-binds -ddump-cpr-signatures'))
+setTestOpts(extra_hc_opts('-dno-typeable-binds -ddump-cpr-signatures -v0'))
 
 test('CaseBinderCPR', normal, compile, [''])
+test('RecDataConCPR', [], multimod_compile, ['RecDataConCPR', ''])
 test('T19232', normal, compile, [''])
 test('T19398', normal, compile, [''])
 test('T19822', normal, compile, [''])