Fix void-arg-adding mechanism for worker/wrapper

As #22725 shows, in worker/wrapper we must add the void argument
/last/, not first.  See GHC.Core.Opt.WorkWrap.Utils
Note [Worker/wrapper needs to add void arg last].

That led me to to study GHC.Core.Opt.SpecConstr
Note [SpecConstr needs to add void args first] which suggests the
opposite!  And indeed I think it's the other way round for SpecConstr
-- or more precisely the void arg must precede the "extra_bndrs".

That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo.

4 files changed, 76 insertions, 58 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index 1d4b3dd9fa..d614ab1f7a 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -1,14 +1,14 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 71, types: 41, coercions: 0, joins: 0/0}
+  = {terms: 71, types: 40, coercions: 0, joins: 0/0}
 
 Rec {
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
-  :: (# #) -> forall {a}. a
+  :: forall {a}. (# #) -> a
 [GblId, Arity=1, Str=<B>b, Cpr=b, Unf=OtherCon []]
-T13143.$wf = \ _ [Occ=Dead] (@a) -> T13143.$wf GHC.Prim.(##) @a
+T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
 end Rec }
 
 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
@@ -17,55 +17,60 @@ f [InlPrag=NOINLINE[final]] :: forall a. Int -> a
  Arity=1,
  Str=<B>b,
  Cpr=b,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
-         Tmpl= \ (@a) _ [Occ=Dead] -> T13143.$wf GHC.Prim.(##) @a}]
-f = \ (@a) _ [Occ=Dead] -> T13143.$wf GHC.Prim.(##) @a
+         Tmpl= \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)}]
+f = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T13143.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T13143.$trModule3 = GHC.Types.TrNameS T13143.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T13143.$trModule2 = "T13143"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T13143.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T13143.$trModule
   = GHC.Types.Module T13143.$trModule3 T13143.$trModule1
 
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-lvl :: forall {a}. a
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+lvl :: Int
 [GblId, Str=b, Cpr=b]
-lvl = T13143.$wf GHC.Prim.(##)
+lvl = T13143.$wf @Int GHC.Prim.(##)
 
 Rec {
--- RHS size: {terms: 28, types: 8, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
 T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
   :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId[StrictWorker([!, !])],
@@ -94,8 +99,8 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
  Arity=3,
  Str=<1L><1L><1!P(L)>,
  Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
          Tmpl= \ (ds [Occ=Once1] :: Bool)
                  (ds1 [Occ=Once1] :: Bool)
diff --git a/testsuite/tests/simplCore/should_compile/T18328.stderr b/testsuite/tests/simplCore/should_compile/T18328.stderr
index 78e3430b88..e5c039d595 100644
--- a/testsuite/tests/simplCore/should_compile/T18328.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18328.stderr
@@ -1,84 +1,90 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 65, types: 53, coercions: 0, joins: 1/1}
+  = {terms: 69, types: 55, coercions: 0, joins: 1/1}
 
--- RHS size: {terms: 38, types: 23, coercions: 0, joins: 1/1}
+-- RHS size: {terms: 42, types: 25, coercions: 0, joins: 1/1}
 T18328.$wf [InlPrag=[2]]
   :: forall {a}. GHC.Prim.Int# -> [a] -> [a] -> [a]
-[GblId,
+[GblId[StrictWorker([~, !])],
  Arity=3,
  Str=<SL><SL><ML>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [176 0 0] 306 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [176 0 0] 306 0}]
 T18328.$wf
-  = \ (@a) (ww :: GHC.Prim.Int#) (w :: [a]) (w1 :: [a]) ->
+  = \ (@a) (ww :: GHC.Prim.Int#) (ys :: [a]) (eta :: [a]) ->
       join {
-        $wj [InlPrag=NOINLINE, Dmd=ML] :: forall {p}. [a]
-        [LclId[JoinId(1)]]
-        $wj (@p)
+        $wj [InlPrag=NOINLINE, Dmd=MC(1,L)] :: forall {p}. (# #) -> [a]
+        [LclId[JoinId(2)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []]
+        $wj (@p) _ [Occ=Dead, OS=OneShot]
           = case ww of {
-              __DEFAULT -> ++ @a w (++ @a w (++ @a w w1));
-              3# -> ++ @a w (++ @a w (++ @a w (++ @a w w1)))
+              __DEFAULT -> ++ @a ys (++ @a ys (++ @a ys eta));
+              3# -> ++ @a ys (++ @a ys (++ @a ys (++ @a ys eta)))
             } } in
       case ww of {
-        __DEFAULT -> ++ @a w w1;
-        1# -> jump $wj @Integer;
-        2# -> jump $wj @Integer;
-        3# -> jump $wj @Integer
+        __DEFAULT -> ++ @a ys eta;
+        1# -> jump $wj @Integer GHC.Prim.(##);
+        2# -> jump $wj @Integer GHC.Prim.(##);
+        3# -> jump $wj @Integer GHC.Prim.(##)
       }
 
 -- RHS size: {terms: 11, types: 9, coercions: 0, joins: 0/0}
 f [InlPrag=[2]] :: forall a. Int -> [a] -> [a] -> [a]
 [GblId,
  Arity=3,
- Str=<1P(SL)><SL><ML>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True,
+ Str=<1!P(SL)><SL><ML>,
+ Unf=Unf{Src=StableSystem, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a)
-                 (w [Occ=Once1!] :: Int)
-                 (w1 [Occ=Once1] :: [a])
-                 (w2 [Occ=Once1] :: [a]) ->
-                 case w of { GHC.Types.I# ww [Occ=Once1] ->
-                 T18328.$wf @a ww w1 w2
+                 (x [Occ=Once1!] :: Int)
+                 (ys [Occ=Once1] :: [a])
+                 (eta [Occ=Once1] :: [a]) ->
+                 case x of { GHC.Types.I# ww [Occ=Once1] ->
+                 T18328.$wf @a ww ys eta
                  }}]
-f = \ (@a) (w :: Int) (w1 :: [a]) (w2 :: [a]) ->
-      case w of { GHC.Types.I# ww -> T18328.$wf @a ww w1 w2 }
+f = \ (@a) (x :: Int) (ys :: [a]) (eta :: [a]) ->
+      case x of { GHC.Types.I# ww -> T18328.$wf @a ww ys eta }
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T18328.$trModule4 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 20 0}]
 T18328.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T18328.$trModule3 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T18328.$trModule3 = GHC.Types.TrNameS T18328.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T18328.$trModule2 :: GHC.Prim.Addr#
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 30 0}]
 T18328.$trModule2 = "T18328"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T18328.$trModule1 :: GHC.Types.TrName
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T18328.$trModule1 = GHC.Types.TrNameS T18328.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T18328.$trModule :: GHC.Types.Module
 [GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+         Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=IF_ARGS [] 10 10}]
 T18328.$trModule
   = GHC.Types.Module T18328.$trModule3 T18328.$trModule1
 
diff --git a/testsuite/tests/simplCore/should_compile/T22725.hs b/testsuite/tests/simplCore/should_compile/T22725.hs
new file mode 100644
index 0000000000..db84a29ed8
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T22725.hs
@@ -0,0 +1,6 @@
+module M where
+
+import GHC.Exts (TYPE)
+
+f :: forall r (a :: TYPE r). () -> a
+f x = f x
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index c5f63d6e7a..e57bb4cafa 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -462,3 +462,4 @@ test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings
 test('T22459', normal, compile, [''])
 test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
 test('T22662', normal, compile, [''])
+test('T22725', normal, compile, ['-O'])