Allow CSE'ing of work-wrapped bindings (#14186)

the worker/wrapper creates an artificial INLINE pragma, which caused CSE
to not do its work. We now recognize such artificial pragmas by using
`NoUserInline` instead of `Inline` as the `InlineSpec`.

Differential Revision: https://phabricator.haskell.org/D3939

10 files changed, 151 insertions, 88 deletions

diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index c9cdd95bc2..9ac62ad090 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -12,7 +12,7 @@ T13143.$wf = \ (@ a) _ [Occ=Dead] -> T13143.$wf @ a GHC.Prim.void#
 end Rec }
 
 -- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
-f [InlPrag=INLINE[0]] :: forall a. Int -> a
+f [InlPrag=NOUSERINLINE[0]] :: forall a. Int -> a
 [GblId,
  Arity=1,
  Caf=NoCafRefs,
@@ -74,7 +74,7 @@ lvl = T13143.$wf @ Int GHC.Prim.void#
 
 Rec {
 -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
-T13143.$wg [InlPrag=[0], Occ=LoopBreaker]
+T13143.$wg [InlPrag=NOUSERINLINE[0], Occ=LoopBreaker]
   :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>]
 T13143.$wg
@@ -94,7 +94,7 @@ T13143.$wg
 end Rec }
 
 -- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0}
-g [InlPrag=INLINE[0]] :: Bool -> Bool -> Int -> Int
+g [InlPrag=NOUSERINLINE[0]] :: Bool -> Bool -> Int -> Int
 [GblId,
  Arity=3,
  Str=<S,1*U><S,1*U><S(S),1*U(U)>m,
diff --git a/testsuite/tests/simplCore/should_compile/T14186.stderr b/testsuite/tests/simplCore/should_compile/T14186.stderr
index ccc9bd9791..17ccc2c07d 100644
--- a/testsuite/tests/simplCore/should_compile/T14186.stderr
+++ b/testsuite/tests/simplCore/should_compile/T14186.stderr
@@ -1,57 +1,119 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 52, types: 99, coercions: 0, joins: 0/0}
+  = {terms: 36, types: 68, coercions: 0, joins: 0/0}
 
--- RHS size: {terms: 18, types: 29, coercions: 0, joins: 0/0}
-foo
+-- RHS size: {terms: 19, types: 27, coercions: 0, joins: 0/0}
+foo [InlPrag=[0]]
   :: forall t1 b t2.
      (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b])
-[GblId, Arity=3]
+[GblId,
+ Arity=3,
+ Caf=NoCafRefs,
+ Str=<L,C(U)><L,C(U)><S,1*U(U,1*U)>m,
+ 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= \ (@ t_sZi)
+                 (@ b_sZj)
+                 (@ t1_sZk)
+                 (w_sZl :: t_sZi -> b_sZj)
+                 (w1_sZm :: t1_sZk -> t_sZi)
+                 (w2_sZn [Occ=Once!] :: (t1_sZk, [t1_sZk])) ->
+                 case w2_sZn of { (ww1_sZq [Occ=Once], ww2_sZr [Occ=Once]) ->
+                 (w_sZl (w1_sZm ww1_sZq),
+                  map
+                    @ t1_sZk
+                    @ b_sZj
+                    (\ (x_aXa [Occ=Once] :: t1_sZk) -> w_sZl (w1_sZm x_aXa))
+                    ww2_sZr)
+                 }}]
 foo
-  = \ (@ t_aUk)
-      (@ b_aUs)
-      (@ t1_aUo)
-      (f_apH :: t_aUk -> b_aUs)
-      (g_apI :: t1_aUo -> t_aUk)
-      (ds_dVH :: (t1_aUo, [t1_aUo])) ->
-      case ds_dVH of { (x_apJ, xs_apK) ->
-      (f_apH (g_apI x_apJ),
+  = \ (@ t_sZi)
+      (@ b_sZj)
+      (@ t1_sZk)
+      (w_sZl :: t_sZi -> b_sZj)
+      (w1_sZm :: t1_sZk -> t_sZi)
+      (w2_sZn :: (t1_sZk, [t1_sZk])) ->
+      case w2_sZn of { (ww1_sZq, ww2_sZr) ->
+      (w_sZl (w1_sZm ww1_sZq),
        map
-         @ t1_aUo @ b_aUs (. @ t_aUk @ b_aUs @ t1_aUo f_apH g_apI) xs_apK)
+         @ t1_sZk
+         @ b_sZj
+         (\ (x_aXa :: t1_sZk) -> w_sZl (w1_sZm x_aXa))
+         ww2_sZr)
       }
 
--- RHS size: {terms: 18, types: 29, coercions: 0, joins: 0/0}
-bar
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+bar [InlPrag=[0]]
   :: forall t1 b t2.
      (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b])
-[GblId, Arity=3]
+[GblId,
+ Arity=3,
+ Caf=NoCafRefs,
+ Str=<L,C(U)><L,C(U)><S,1*U(U,1*U)>m,
+ 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= \ (@ t_sZx)
+                 (@ b_sZy)
+                 (@ t1_sZz)
+                 (w_sZA :: t_sZx -> b_sZy)
+                 (w1_sZB :: t1_sZz -> t_sZx)
+                 (w2_sZC [Occ=Once!] :: (t1_sZz, [t1_sZz])) ->
+                 case w2_sZC of { (ww1_sZF [Occ=Once], ww2_sZG [Occ=Once]) ->
+                 (w_sZA (w1_sZB ww1_sZF),
+                  map
+                    @ t1_sZz
+                    @ b_sZy
+                    (\ (x_aXa [Occ=Once] :: t1_sZz) -> w_sZA (w1_sZB x_aXa))
+                    ww2_sZG)
+                 }}]
 bar = foo
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-$trModule1_rVy :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs]
-$trModule1_rVy = "main"#
+T14186.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+T14186.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-$trModule2_rVX :: GHC.Types.TrName
-[GblId, Caf=NoCafRefs]
-$trModule2_rVX = GHC.Types.TrNameS $trModule1_rVy
+T14186.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+T14186.$trModule3 = GHC.Types.TrNameS T14186.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-$trModule3_rVY :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs]
-$trModule3_rVY = "T14186"#
+T14186.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T14186.$trModule2 = "T14186"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-$trModule4_rVZ :: GHC.Types.TrName
-[GblId, Caf=NoCafRefs]
-$trModule4_rVZ = GHC.Types.TrNameS $trModule3_rVY
+T14186.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+T14186.$trModule1 = GHC.Types.TrNameS T14186.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T14186.$trModule :: GHC.Types.Module
-[GblId, Caf=NoCafRefs]
-T14186.$trModule = GHC.Types.Module $trModule2_rVX $trModule4_rVZ
+[GblId,
+ Caf=NoCafRefs,
+ Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+T14186.$trModule
+  = GHC.Types.Module T14186.$trModule3 T14186.$trModule1
 
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr
index 9bcc4f31ac..35b4fa8dbd 100644
--- a/testsuite/tests/simplCore/should_compile/T3717.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3717.stderr
@@ -44,24 +44,24 @@ T3717.$trModule :: GHC.Types.Module
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T3717.$trModule =
-  GHC.Types.Module T3717.$trModule3 T3717.$trModule1
+T3717.$trModule
+  = GHC.Types.Module T3717.$trModule3 T3717.$trModule1
 
 Rec {
 -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
-T3717.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+T3717.$wfoo [InlPrag=NOUSERINLINE[0], Occ=LoopBreaker]
   :: GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
-T3717.$wfoo =
-  \ (ww :: GHC.Prim.Int#) ->
-    case ww of ds {
-      __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#);
-      0# -> 0#
-    }
+T3717.$wfoo
+  = \ (ww :: GHC.Prim.Int#) ->
+      case ww of ds {
+        __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#);
+        0# -> 0#
+      }
 end Rec }
 
 -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
-foo [InlPrag=INLINE[0]] :: Int -> Int
+foo [InlPrag=NOUSERINLINE[0]] :: Int -> Int
 [GblId,
  Arity=1,
  Caf=NoCafRefs,
@@ -73,11 +73,11 @@ foo [InlPrag=INLINE[0]] :: Int -> Int
                  case w of { GHC.Types.I# ww1 [Occ=Once] ->
                  case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
                  }}]
-foo =
-  \ (w :: Int) ->
-    case w of { GHC.Types.I# ww1 ->
-    case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
-    }
+foo
+  = \ (w :: Int) ->
+      case w of { GHC.Types.I# ww1 ->
+      case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+      }
 
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index a4ab97da38..409db79c93 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -70,7 +70,7 @@ T3772.$wfoo
       }
 
 -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-foo [InlPrag=INLINE[0]] :: Int -> ()
+foo [InlPrag=NOUSERINLINE[0]] :: Int -> ()
 [GblId,
  Arity=1,
  Caf=NoCafRefs,
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index 185b9b3529..2f805f074a 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -44,50 +44,50 @@ T4908.$trModule :: Module
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T4908.$trModule =
-  GHC.Types.Module T4908.$trModule3 T4908.$trModule1
+T4908.$trModule
+  = GHC.Types.Module T4908.$trModule3 T4908.$trModule1
 
 Rec {
 -- RHS size: {terms: 19, types: 5, coercions: 0, joins: 0/0}
 T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool
 [GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>]
-T4908.f_$s$wf =
-  \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) ->
-    case sc2 of ds {
-      __DEFAULT ->
-        case sc1 of ds1 {
-          __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#);
-          0# -> GHC.Types.True
-        };
-      0# -> GHC.Types.True
-    }
+T4908.f_$s$wf
+  = \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) ->
+      case sc2 of ds {
+        __DEFAULT ->
+          case sc1 of ds1 {
+            __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#);
+            0# -> GHC.Types.True
+          };
+        0# -> GHC.Types.True
+      }
 end Rec }
 
 -- RHS size: {terms: 24, types: 13, coercions: 0, joins: 0/0}
-T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool
+T4908.$wf [InlPrag=NOUSERINLINE[0]] :: Int# -> (Int, Int) -> Bool
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
  Str=<S,1*U><L,1*U(A,1*U(1*U))>,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}]
-T4908.$wf =
-  \ (ww :: Int#) (w :: (Int, Int)) ->
-    case ww of ds {
-      __DEFAULT ->
-        case w of { (a, b) ->
-        case b of { I# ds1 ->
-        case ds1 of ds2 {
-          __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
-          0# -> GHC.Types.True
-        }
-        }
-        };
-      0# -> GHC.Types.True
-    }
+T4908.$wf
+  = \ (ww :: Int#) (w :: (Int, Int)) ->
+      case ww of ds {
+        __DEFAULT ->
+          case w of { (a, b) ->
+          case b of { I# ds1 ->
+          case ds1 of ds2 {
+            __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
+            0# -> GHC.Types.True
+          }
+          }
+          };
+        0# -> GHC.Types.True
+      }
 
 -- RHS size: {terms: 8, types: 6, coercions: 0, joins: 0/0}
-f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
+f [InlPrag=NOUSERINLINE[0]] :: Int -> (Int, Int) -> Bool
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
@@ -97,9 +97,8 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
          Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
                  case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
-f =
-  \ (w :: Int) (w1 :: (Int, Int)) ->
-    case w of { I# ww1 -> T4908.$wf ww1 w1 }
+f = \ (w :: Int) (w1 :: (Int, Int)) ->
+      case w of { I# ww1 -> T4908.$wf ww1 w1 }
 
 
 ------ Local rules for imported ids --------
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 4d569485b3..2e5416303a 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -49,7 +49,7 @@ T4930.$trModule
 
 Rec {
 -- RHS size: {terms: 17, types: 3, coercions: 0, joins: 0/0}
-T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+T4930.$wfoo [InlPrag=NOUSERINLINE[0], Occ=LoopBreaker]
   :: GHC.Prim.Int# -> GHC.Prim.Int#
 [GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
 T4930.$wfoo
@@ -61,7 +61,7 @@ T4930.$wfoo
 end Rec }
 
 -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
-foo [InlPrag=INLINE[0]] :: Int -> Int
+foo [InlPrag=NOUSERINLINE[0]] :: Int -> Int
 [GblId,
  Arity=1,
  Caf=NoCafRefs,
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 118ebbe886..cf86246e45 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -160,7 +160,7 @@ T7360.$tcFoo
       GHC.Types.krep$*
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
-T7360.$tc'Foo4 [InlPrag=[~]] :: GHC.Types.KindRep
+T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep
 [GblId, Caf=NoCafRefs, Str=m1]
 T7360.$tc'Foo4
   = GHC.Types.KindRepTyConApp
@@ -233,7 +233,7 @@ T7360.$tc'Foo2
       T7360.$tc'Foo4
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T7360.$tc'Foo9 [InlPrag=[~]] :: GHC.Types.KindRep
+T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep
 [GblId, Caf=NoCafRefs, Str=m4]
 T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4
 
diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout
index 5cf005071d..7ea5449fbe 100644
--- a/testsuite/tests/simplCore/should_compile/T7865.stdout
+++ b/testsuite/tests/simplCore/should_compile/T7865.stdout
@@ -1,6 +1,6 @@
 T7865.$wexpensive [InlPrag=NOINLINE]
 T7865.$wexpensive
-expensive [InlPrag=INLINE[0]] :: Int -> Int
+expensive [InlPrag=NOUSERINLINE[0]] :: Int -> Int
                  case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
 expensive
       case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 3eae1ff956..a692007ff0 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -273,4 +273,4 @@ test('T13708', normal, compile, [''])
 # thunk should inline here, so check whether or not it appears in the Core
 test('T14137', [ check_errmsg(r'thunk') ], compile, ['-dsuppress-uniques -ddump-simpl'])
 # bar and foo should CSEd here, so check for that in the Core
-test('T14186', [ only_ways(['optasm']), check_errmsg(r'bar = foo'), expect_broken(14186) ], compile, ['-ddump-simpl'])
+test('T14186', [ only_ways(['optasm']), check_errmsg(r'bar = foo') ], compile, ['-ddump-simpl'])
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 53b315dc9c..8caba3df72 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -90,7 +90,8 @@ Roman.foo_$s$wgo
 end Rec }
 
 -- RHS size: {terms: 71, types: 19, coercions: 0, joins: 0/1}
-Roman.$wgo [InlPrag=[0]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
+Roman.$wgo [InlPrag=NOUSERINLINE[0]]
+  :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
 [GblId,
  Arity=2,
  Str=<S,1*U><S,1*U>,
@@ -134,7 +135,8 @@ Roman.$wgo
       }
 
 -- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0}
-Roman.foo_go [InlPrag=INLINE[0]] :: Maybe Int -> Maybe Int -> Int
+Roman.foo_go [InlPrag=NOUSERINLINE[0]]
+  :: Maybe Int -> Maybe Int -> Int
 [GblId,
  Arity=2,
  Str=<S,1*U><S,1*U>m,