Improve aggressive specialisation

This patch fixes #21286, by not unboxing dictionaries in
worker/wrapper (ever). The main payload is tiny:

* In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox
  dictionaries in `get_dmd`.  See Note [Do not unbox class dictionaries]
  in that module

* I also found that imported wrappers were being fruitlessly
  specialised, so I fixed that too, in canSpecImport.
  See Note [Specialising imported functions] point (2).

In doing due diligence in the testsuite I fixed a number of
other things:

* Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make,
  and Note [Inline specialisations] in GHC.Core.Opt.Specialise,
  and remove duplication between the two. The new Note describes
  how we specialise functions with an INLINABLE pragma.

  And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`.

* Improve Note [Worker/wrapper for INLINABLE functions] in
  GHC.Core.Opt.WorkWrap.

  And (critially) make an actual change which is to propagate the
  user-written pragma from the original function to the wrapper; see
  `mkStrWrapperInlinePrag`.

* Write new Note [Specialising imported functions] in
  GHC.Core.Opt.Specialise

All this has a big effect on some compile times. This is
compiler/perf, showing only changes over 1%:

Metrics: compile_time/bytes allocated
-------------------------------------
                LargeRecord(normal)  -50.2% GOOD
           ManyConstructors(normal)   +1.0%
MultiLayerModulesTH_OneShot(normal)   +2.6%
                  PmSeriesG(normal)   -1.1%
                     T10547(normal)   -1.2%
                     T11195(normal)   -1.2%
                     T11276(normal)   -1.0%
                    T11303b(normal)   -1.6%
                     T11545(normal)   -1.4%
                     T11822(normal)   -1.3%
                     T12150(optasm)   -1.0%
                     T12234(optasm)   -1.2%
                     T13056(optasm)   -9.3% GOOD
                     T13253(normal)   -3.8% GOOD
                     T15164(normal)   -3.6% GOOD
                     T16190(normal)   -2.1%
                     T16577(normal)   -2.8% GOOD
                     T16875(normal)   -1.6%
                     T17836(normal)   +2.2%
                    T17977b(normal)   -1.0%
                     T18223(normal)  -33.3% GOOD
                     T18282(normal)   -3.4% GOOD
                     T18304(normal)   -1.4%
                    T18698a(normal)   -1.4% GOOD
                    T18698b(normal)   -1.3% GOOD
                     T19695(normal)   -2.5% GOOD
                      T5837(normal)   -2.3%
                      T9630(normal)  -33.0% GOOD
                      WWRec(normal)   -9.7% GOOD
             hard_hole_fits(normal)   -2.1% GOOD
                     hie002(normal)   +1.6%

                          geo. mean   -2.2%
                          minimum    -50.2%
                          maximum     +2.6%

I diligently investigated some of the big drops.

* Caused by not doing w/w for dictionaries:
    T13056, T15164, WWRec, T18223

* Caused by not fruitlessly specialising wrappers
    LargeRecord, T9630

For runtimes, here is perf/should+_run:

Metrics: runtime/bytes allocated
--------------------------------
               T12990(normal)   -3.8%
                T5205(normal)   -1.3%
                T9203(normal)  -10.7% GOOD
        haddock.Cabal(normal)   +0.1%
         haddock.base(normal)   -1.1%
     haddock.compiler(normal)   -0.3%
        lazy-bs-alloc(normal)   -0.2%
------------------------------------------
                    geo. mean   -0.3%
                    minimum    -10.7%
                    maximum     +0.1%

I did not investigate exactly what happens in T9203.

Nofib is a wash:

+-------------------------------++--+-----------+-----------+
|                               ||  | tsv (rel) | std. err. |
+===============================++==+===========+===========+
|                     real/anna ||  |    -0.13% |      0.0% |
|                      real/fem ||  |    +0.13% |      0.0% |
|                   real/fulsom ||  |    -0.16% |      0.0% |
|                     real/lift ||  |    -1.55% |      0.0% |
|                  real/reptile ||  |    -0.11% |      0.0% |
|                  real/smallpt ||  |    +0.51% |      0.0% |
|          spectral/constraints ||  |    +0.20% |      0.0% |
|               spectral/dom-lt ||  |    +1.80% |      0.0% |
|               spectral/expert ||  |    +0.33% |      0.0% |
+===============================++==+===========+===========+
|                     geom mean ||  |           |           |
+-------------------------------++--+-----------+-----------+

I spent quite some time investigating dom-lt, but it's pretty
complicated.  See my note on !7847.  Conclusion: it's just a delicate
inlining interaction, and we have plenty of those.

Metric Decrease:
    LargeRecord
    T13056
    T13253
    T15164
    T16577
    T18223
    T18282
    T18698a
    T18698b
    T19695
    T9630
    WWRec
    hard_hole_fits
    T9203

12 files changed, 116 insertions, 61 deletions

diff --git a/testsuite/tests/arityanal/should_compile/Arity05.stderr b/testsuite/tests/arityanal/should_compile/Arity05.stderr
index 91c909ecc6..17a0fb668a 100644
--- a/testsuite/tests/arityanal/should_compile/Arity05.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity05.stderr
@@ -1,6 +1,6 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 56, types: 87, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 42, types: 44, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 F5.f5g1 :: Integer
@@ -9,26 +9,13 @@ F5.f5g1 = GHC.Num.Integer.IS 1#
 
 -- RHS size: {terms: 12, types: 9, coercions: 0, joins: 0/0}
 f5g :: forall {a} {t}. Num a => (t -> a) -> t -> a
-[GblId,
- Arity=3,
- Str=<SP(1C1(C1(L)),A,A,A,A,A,MC1(L))><MC1(L)><L>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (@a) (@t) ($dNum :: Num a) (h [Occ=Once1!] :: t -> a) (z [Occ=Once1] :: t) -> + @a $dNum (h z) (fromInteger @a $dNum F5.f5g1)}]
+[GblId, Arity=3, Str=<SP(1C1(C1(L)),A,A,A,A,A,MC1(L))><MC1(L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 0] 90 0}]
 f5g = \ (@a) (@t) ($dNum :: Num a) (h :: t -> a) (z :: t) -> + @a $dNum (h z) (fromInteger @a $dNum F5.f5g1)
 
--- RHS size: {terms: 15, types: 12, coercions: 0, joins: 0/0}
-F5.$wf5h [InlPrag=[2]] :: forall {a} {t}. (a -> a -> a) -> (Integer -> a) -> (t -> a) -> t -> (t -> a) -> a
-[GblId, Arity=5, Str=<SCS(C1(L))><MC1(L)><MC1(L)><L><MC1(L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 60 0 60] 120 0}]
-F5.$wf5h = \ (@a) (@t) (ww :: a -> a -> a) (ww1 :: Integer -> a) (f :: t -> a) (x :: t) (g :: t -> a) -> ww (f x) (ww (g x) (ww1 F5.f5g1))
-
--- RHS size: {terms: 15, types: 30, coercions: 0, joins: 0/0}
-f5h [InlPrag=[2]] :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a
-[GblId,
- Arity=4,
- Str=<1P(SCS(C1(L)),A,A,A,A,A,MC1(L))><MC1(L)><L><MC1(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= \ (@a) (@t) ($dNum [Occ=Once1!] :: Num a) (f [Occ=Once1] :: t -> a) (x [Occ=Once1] :: t) (g [Occ=Once1] :: t -> a) -> case $dNum of { GHC.Num.C:Num ww [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] ww6 [Occ=Once1] -> F5.$wf5h @a @t ww ww6 f x g }}]
-f5h = \ (@a) (@t) ($dNum :: Num a) (f :: t -> a) (x :: t) (g :: t -> a) -> case $dNum of { GHC.Num.C:Num ww ww1 ww2 ww3 ww4 ww5 ww6 -> F5.$wf5h @a @t ww ww6 f x g }
+-- RHS size: {terms: 17, types: 12, coercions: 0, joins: 0/0}
+f5h :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a
+[GblId, Arity=4, Str=<SP(SCS(C1(L)),A,A,A,A,A,MC1(L))><MC1(L)><L><MC1(L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60 0 60] 150 0}]
+f5h = \ (@a) (@t) ($dNum :: Num a) (f :: t -> a) (x :: t) (g :: t -> a) -> + @a $dNum (f x) (+ @a $dNum (g x) (fromInteger @a $dNum F5.f5g1))
 
 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
 f5y :: Integer -> Integer
diff --git a/testsuite/tests/arityanal/should_compile/Arity11.stderr b/testsuite/tests/arityanal/should_compile/Arity11.stderr
index 6144198ac4..82b162e531 100644
--- a/testsuite/tests/arityanal/should_compile/Arity11.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity11.stderr
@@ -1,6 +1,6 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 149, types: 104, coercions: 0, joins: 2/7}
+Result size of Tidy Core = {terms: 136, types: 75, coercions: 0, joins: 2/7}
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 F11.fib3 :: Integer
@@ -51,11 +51,11 @@ F11.fib1 :: Integer
 [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 F11.fib1 = GHC.Num.Integer.IS 0#
 
--- RHS size: {terms: 52, types: 26, coercions: 0, joins: 0/5}
-F11.$wfib [InlPrag=[2]] :: forall {t} {a}. (t -> t -> Bool) -> (Num t, Num a) => t -> a
-[GblId, Arity=4, Str=<SCS(C1(L))><LP(A,LCL(C1(L)),A,A,A,A,L)><LP(LCS(C1(L)),A,A,A,A,A,MC1(L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}]
-F11.$wfib
-  = \ (@t) (@a) (ww :: t -> t -> Bool) ($dNum :: Num t) ($dNum1 :: Num a) (eta :: t) ->
+-- RHS size: {terms: 54, types: 27, coercions: 0, joins: 0/5}
+fib :: forall {t} {a}. (Eq t, Num t, Num a) => t -> a
+[GblId, Arity=4, Str=<SP(SCS(C1(L)),A)><LP(A,LCL(C1(L)),A,A,A,A,L)><LP(LCS(C1(L)),A,A,A,A,A,MC1(L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 480 0}]
+fib
+  = \ (@t) (@a) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num a) (eta :: t) ->
       let {
         lvl :: t
         [LclId]
@@ -77,9 +77,9 @@ F11.$wfib
         [LclId, Arity=1, Str=<L>, Unf=OtherCon []]
         fib4
           = \ (ds :: t) ->
-              case ww ds lvl3 of {
+              case == @t $dEq ds lvl3 of {
                 False ->
-                  case ww ds lvl of {
+                  case == @t $dEq ds lvl of {
                     False -> + @a $dNum1 (fib4 (- @t $dNum ds lvl)) (fib4 (- @t $dNum ds lvl1));
                     True -> lvl2
                   };
@@ -87,15 +87,6 @@ F11.$wfib
               }; } in
       fib4 eta
 
--- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
-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(LCS(C1(L)),A,A,A,A,A,LCS(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) ($dEq [Occ=Once1!] :: Eq t) ($dNum [Occ=Once1] :: Num t) ($dNum1 [Occ=Once1] :: Num a) (eta [Occ=Once1] :: t) -> case $dEq of { GHC.Classes.C:Eq ww [Occ=Once1] _ [Occ=Dead] -> F11.$wfib @t @a ww $dNum $dNum1 eta }}]
-fib = \ (@t) (@a) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num a) (eta :: t) -> case $dEq of { GHC.Classes.C:Eq ww ww1 -> F11.$wfib @t @a ww $dNum $dNum1 eta }
-
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 F11.f3 :: Integer
 [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
diff --git a/testsuite/tests/arityanal/should_compile/Arity14.stderr b/testsuite/tests/arityanal/should_compile/Arity14.stderr
index 966106bdbc..6fccde58a1 100644
--- a/testsuite/tests/arityanal/should_compile/Arity14.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity14.stderr
@@ -1,6 +1,6 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 57, types: 81, coercions: 0, joins: 0/3}
+Result size of Tidy Core = {terms: 44, types: 38, coercions: 0, joins: 0/3}
 
 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
 F14.f1 :: forall {t}. t -> t
@@ -12,11 +12,11 @@ F14.f2 :: Integer
 [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 F14.f2 = GHC.Num.Integer.IS 1#
 
--- RHS size: {terms: 35, types: 23, coercions: 0, joins: 0/3}
-F14.$wf14 [InlPrag=[2]] :: forall {t}. (t -> t -> Bool) -> Num t => t -> t -> t -> t
-[GblId, Arity=4, Str=<SCS(C1(L))><LP(LCL(C1(L)),A,A,A,A,A,MC1(L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 90 0 0] 300 0}]
-F14.$wf14
-  = \ (@t) (ww :: t -> t -> Bool) ($dNum :: Num t) (eta :: t) (eta1 :: t) ->
+-- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/3}
+f14 :: forall {t}. (Ord t, Num t) => t -> t -> t -> t
+[GblId, Arity=4, Str=<SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(LCL(C1(L)),A,A,A,A,A,MC1(L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 90 0 0] 310 0}]
+f14
+  = \ (@t) ($dOrd :: Ord t) ($dNum :: Num t) (eta :: t) (eta1 :: t) ->
       let {
         lvl :: t
         [LclId]
@@ -26,7 +26,7 @@ F14.$wf14
         [LclId, Arity=2, Str=<L><L>, Unf=OtherCon []]
         f3
           = \ (n :: t) (x :: t) ->
-              case ww x n of {
+              case < @t $dOrd x n of {
                 False -> F14.f1 @t;
                 True ->
                   let {
@@ -37,14 +37,5 @@ F14.$wf14
               }; } in
       f3 eta eta1
 
--- RHS size: {terms: 13, types: 33, coercions: 0, joins: 0/0}
-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,LCS(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) ($dOrd [Occ=Once1!] :: Ord t) ($dNum [Occ=Once1] :: Num t) (eta [Occ=Once1] :: t) (eta1 [Occ=Once1] :: t) -> case $dOrd 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 $dNum eta eta1 }}]
-f14 = \ (@t) ($dOrd :: Ord t) ($dNum :: Num t) (eta :: t) (eta1 :: t) -> case $dOrd of { GHC.Classes.C:Ord ww ww1 ww2 ww3 ww4 ww5 ww6 ww7 -> F14.$wf14 @t ww2 $dNum eta eta1 }
-
 
 
diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr
index dec839f72b..e2fcedcd2b 100644
--- a/testsuite/tests/indexed-types/should_compile/T7837.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr
@@ -1,7 +1,3 @@
 Rule fired: Class op signum (BUILTIN)
 Rule fired: Class op abs (BUILTIN)
 Rule fired: normalize/Double (T7837)
-Rule fired: Class op eq_sel (BUILTIN)
-Rule fired: Class op $p1Norm (BUILTIN)
-Rule fired: Class op / (BUILTIN)
-Rule fired: Class op norm (BUILTIN)
diff --git a/testsuite/tests/perf/compiler/LargeRecord.hs b/testsuite/tests/perf/compiler/LargeRecord.hs
index 11a35593ab..c31ef0ed08 100644
--- a/testsuite/tests/perf/compiler/LargeRecord.hs
+++ b/testsuite/tests/perf/compiler/LargeRecord.hs
@@ -9,6 +9,49 @@
 
 {-# OPTIONS_GHC -freduction-depth=0 #-}
 
+{- Notes on LargeRecord
+~~~~~~~~~~~~~~~~~~~~~~~
+I noticed that in GHC of July 2022, when compiling this
+module I got lots of "SPEC" rules
+
+      SuperRecord.$fRecCopy:ltsrts_$crecCopyInto @"f2"
+                                                 @'["f1" := Int, "f2" := Int, "f3" := Int,
+                                                    "f4" := Int]
+                                                 @Int
+                                                 @'["f2" := Int, "f3" := Int, "f4" := Int]
+                                                 @'["f3" := Int, "f4" := Int]
+                                                 $d(%,,%)_X1 $d(%,,%)1_X2 $dRecCopy_X3
+      SuperRecord.$fRecCopy:ltsrts_$crecCopyInto @"f3"
+                                                 @'["f1" := Int, "f2" := Int, "f3" := Int,
+                                                    "f4" := Int]
+                                                 @Int
+                                                 @'["f2" := Int, "f3" := Int, "f4" := Int]
+                                                 @'["f4" := Int]
+                                                 $d(%,,%)_X1 $d(%,,%)1_s6yK $dRecCopy_X2
+
+      SuperRecord.$fRecCopy:ltsrts_$crecCopyInto @"f3"
+                                                 @'["f2" := Int, "f3" := Int, "f4" := Int]
+                                                 @Int
+                                                 @'["f3" := Int, "f4" := Int]
+                                                 @'["f4" := Int]
+                                                 $d(%,,%)_s6yr $d(%,,%)1_X1 $dRecCopy_X2
+      SuperRecord.$fRecCopy:ltsrts_$crecCopyInto @"f4"
+                                                 @(SortInsert'
+                                                     (GHC.TypeLits.Internal.CmpSymbol "f3" "f4")
+                                                     ("f3" := Int)
+                                                     ("f4" := Int)
+                                                     '[])
+                                                 @Int
+                                                 @'["f4" := Int]
+                                                 @'[]
+                                                 $d(%,,%)_X1 $d(%,,%)1_X2 $dRecCopy_s6yb
+
+(This was with BigFieldList having only four elements.)
+
+The relevant function SuperRecord.$fRecCopy:ltsrts_$crecCopyInto is
+only a wrapper that we were specialising -- little or no benefit.  We
+don't want to specialise wrappers!  -}
+
 module DCo_Record where
 
 import SuperRecord
diff --git a/testsuite/tests/perf/compiler/T18223.hs b/testsuite/tests/perf/compiler/T18223.hs
index 3e160cc957..cb7374bc78 100644
--- a/testsuite/tests/perf/compiler/T18223.hs
+++ b/testsuite/tests/perf/compiler/T18223.hs
@@ -1,6 +1,20 @@
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE Strict #-}
 
+{- Notes on T18223
+~~~~~~~~~~~~~~~~~~
+If we inline
+      modify' :: MonadState s m => (s -> s) -> m ()
+early, before the specialiser, the casts all collapse immediately.
+It turns out that fixing #21286 causes this to happen, because
+we no longer w/w modify'.
+
+If we don't inline it before the specialiser we generate
+a specialised version of it.  Then it gets inlined and all
+the casts collapse, but we end up keeping the code for the
+specialised version right through the pipeline.
+-}
+
 import Control.Monad.State
 
 tester :: MonadState a m => m ()
diff --git a/testsuite/tests/simplCore/should_compile/T21261.stderr b/testsuite/tests/simplCore/should_compile/T21261.stderr
index 2af8b37a5d..fadd73c219 100644
--- a/testsuite/tests/simplCore/should_compile/T21261.stderr
+++ b/testsuite/tests/simplCore/should_compile/T21261.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 182, types: 191, coercions: 0, joins: 0/0}
+  = {terms: 139, types: 130, coercions: 0, joins: 0/0}
 
 lvl = I# 3#
 
@@ -35,8 +35,7 @@ $wf7 = \ c -> (# case c lvl2 of { __DEFAULT -> c lvl lvl1 } #)
 
 f7 = \ c -> case $wf7 c of { (# ww #) -> Just ww }
 
-no_tricky_lazy
-  = \ c -> case $wf7 (\ x y -> c x y) of { (# ww #) -> Just ww }
+no_tricky_lazy = \ c -> f7 (\ x y -> c x y)
 
 $wf5
   = \ c ->
diff --git a/testsuite/tests/simplCore/should_compile/T21286.hs b/testsuite/tests/simplCore/should_compile/T21286.hs
new file mode 100644
index 0000000000..79b9db76d9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T21286.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+
+module T21286 where
+import T21286a
+
+x = f (3::Int)
diff --git a/testsuite/tests/simplCore/should_compile/T21286.stderr b/testsuite/tests/simplCore/should_compile/T21286.stderr
new file mode 100644
index 0000000000..f2901c5b5e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T21286.stderr
@@ -0,0 +1,16 @@
+[1 of 2] Compiling T21286a          ( T21286a.hs, T21286a.o )
+[2 of 2] Compiling T21286           ( T21286.hs, T21286.o )
+Rule fired: Class op + (BUILTIN)
+Rule fired: Class op fromInteger (BUILTIN)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Class op fromInteger (BUILTIN)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: SPEC/T21286 g @Int (T21286)
+Rule fired: SPEC/T21286 g @Int (T21286)
+Rule fired: ==# (BUILTIN)
+Rule fired: tagToEnum# (BUILTIN)
+Rule fired: tagToEnum# (BUILTIN)
diff --git a/testsuite/tests/simplCore/should_compile/T21286a.hs b/testsuite/tests/simplCore/should_compile/T21286a.hs
new file mode 100644
index 0000000000..58f6db9b94
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T21286a.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
+
+module T21286a( f ) where
+
+f :: (Eq a, Num a) => a -> a
+f x = g 20 x + 1
+
+g :: (Eq a, Num a) => a -> a -> a
+g n x | n + 1 == 0 = 0
+      | otherwise  = x + g (n-1) x
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 5091485681..2da9a99ca1 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -428,3 +428,5 @@ test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules'])
 test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules'])
 test('T22028', normal, compile, ['-O -ddump-rule-firings'])
 test('T22114', normal, compile, ['-O'])
+test('T21286',  normal, multimod_compile, ['T21286', '-O -ddump-rule-firings'])
+
diff --git a/testsuite/tests/stranal/sigs/T5075.stderr b/testsuite/tests/stranal/sigs/T5075.stderr
index 5b3701ef56..4cebcf85ae 100644
--- a/testsuite/tests/stranal/sigs/T5075.stderr
+++ b/testsuite/tests/stranal/sigs/T5075.stderr
@@ -1,6 +1,6 @@
 
 ==================== Strictness signatures ====================
-T5075.f: <S!P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCS(C1(L)),A,A,A,L)><L>
+T5075.f: <SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCS(C1(L)),A,A,A,L)><L>
 T5075.g: <1L><S!P(L)>
 T5075.h: <S!P(L)>
 
@@ -14,7 +14,7 @@ T5075.h:
 
 
 ==================== Strictness signatures ====================
-T5075.f: <1P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCS(C1(L)),A,A,A,L)><L>
+T5075.f: <SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCS(C1(L)),A,A,A,L)><L>
 T5075.g: <1L><S!P(L)>
 T5075.h: <1!P(L)>