Add the OPAQUE pragma

A new pragma, `OPAQUE`, that ensures that every call of a named
function annotated with an `OPAQUE` pragma remains a call of that
named function, not some name-mangled variant.

Implements GHC proposal 0415:
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst

This commit also updates the haddock submodule to handle the newly
introduced lexer tokens corresponding to the OPAQUE pragma.

19 files changed, 1035 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.hs
new file mode 100644
index 0000000000..6dfb874e3c
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.hs
@@ -0,0 +1,5 @@
+module OpaqueNoAbsentArgWW where
+
+f :: Int -> Int -> Bool
+f _ i = i == 0
+{-# OPAQUE f #-}
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.stderr
new file mode 100644
index 0000000000..023dd7d502
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoAbsentArgWW.stderr
@@ -0,0 +1,54 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 26, types: 13, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoAbsentArgWW.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoAbsentArgWW.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoAbsentArgWW.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoAbsentArgWW.$trModule3
+  = GHC.Types.TrNameS OpaqueNoAbsentArgWW.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoAbsentArgWW.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 60 0}]
+OpaqueNoAbsentArgWW.$trModule2 = "OpaqueNoAbsentArgWW"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoAbsentArgWW.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoAbsentArgWW.$trModule1
+  = GHC.Types.TrNameS OpaqueNoAbsentArgWW.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoAbsentArgWW.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoAbsentArgWW.$trModule
+  = GHC.Types.Module
+      OpaqueNoAbsentArgWW.$trModule3 OpaqueNoAbsentArgWW.$trModule1
+
+-- RHS size: {terms: 11, types: 5, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE] :: Int -> Int -> Bool
+[GblId, Arity=2, Str=<A><1P(1L)>, Unf=OtherCon []]
+f = / _ [Occ=Dead] (i :: Int) ->
+      case i of { GHC.Types.I# x ->
+      case x of {
+        __DEFAULT -> GHC.Types.False;
+        0# -> GHC.Types.True
+      }
+      }
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.hs
new file mode 100644
index 0000000000..068ac4d4af
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DataKinds #-}
+{-# OPTIONS_GHC -O0 #-}
+module OpaqueNoCastWW where
+
+import GHC.TypeNats
+
+newtype Signed (n :: Nat) = S { unsafeToInteger :: Integer}
+
+-- Normally introduces a worker of type: Signed m -> Signed n -> Integer
+times :: Signed m -> Signed n -> Signed (m + n)
+times (S a) (S b) = S (a * b)
+{-# OPAQUE times #-}
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
new file mode 100644
index 0000000000..00a0421915
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
@@ -0,0 +1,153 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 82, types: 52, coercions: 29, joins: 0/0}
+
+-- RHS size: {terms: 3, types: 3, coercions: 0, joins: 0/0}
+unsafeToInteger1 :: forall {n :: Nat}. Signed n -> Signed n
+[GblId, Arity=1, Unf=OtherCon []]
+unsafeToInteger1 = \ (@(n :: Nat)) (ds :: Signed n) -> ds
+
+-- RHS size: {terms: 1, types: 0, coercions: 8, joins: 0/0}
+unsafeToInteger :: forall (n :: Nat). Signed n -> Integer
+[GblId[[RecSel]], Arity=1, Unf=OtherCon []]
+unsafeToInteger
+  = unsafeToInteger1
+    `cast` (forall (n :: <Nat>_N).
+            <Signed n>_R %<'Many>_N ->_R OpaqueNoCastWW.N:Signed[0] <n>_P
+            :: (forall {n :: Nat}. Signed n -> Signed n)
+               ~R# (forall {n :: Nat}. Signed n -> Integer))
+
+-- RHS size: {terms: 8, types: 7, coercions: 21, joins: 0/0}
+times [InlPrag=OPAQUE]
+  :: forall (m :: Nat) (n :: Nat).
+     Signed m -> Signed n -> Signed (m + n)
+[GblId, Arity=2, Unf=OtherCon []]
+times
+  = (\ (@(m :: Nat))
+       (@(n :: Nat))
+       (ds :: Signed m)
+       (ds1 :: Signed n) ->
+       * @Integer
+         GHC.Num.$fNumInteger
+         (ds
+          `cast` (OpaqueNoCastWW.N:Signed[0] <m>_P :: Signed m ~R# Integer))
+         (ds1
+          `cast` (OpaqueNoCastWW.N:Signed[0] <n>_P :: Signed n ~R# Integer)))
+    `cast` (forall (m :: <Nat>_N) (n :: <Nat>_N).
+            <Signed m>_R
+            %<'Many>_N ->_R <Signed n>_R
+            %<'Many>_N ->_R Sym (OpaqueNoCastWW.N:Signed[0] <m + n>_P)
+            :: (forall {m :: Nat} {n :: Nat}. Signed m -> Signed n -> Integer)
+               ~R# (forall {m :: Nat} {n :: Nat}.
+                    Signed m -> Signed n -> Signed (m + n)))
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule1 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$trModule1 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule2 :: GHC.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule2 = GHC.Types.TrNameS $trModule1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule3 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$trModule3 = "OpaqueNoCastWW"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule4 :: GHC.Types.TrName
+[GblId, Unf=OtherCon []]
+$trModule4 = GHC.Types.TrNameS $trModule3
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoCastWW.$trModule :: GHC.Types.Module
+[GblId, Unf=OtherCon []]
+OpaqueNoCastWW.$trModule = GHC.Types.Module $trModule2 $trModule4
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$krep :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep = GHC.Types.KindRepVar 0#
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep1 :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep1
+  = GHC.Types.KindRepTyConApp
+      GHC.Num.Integer.$tcInteger (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep2 :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep2
+  = GHC.Types.KindRepTyConApp
+      GHC.Num.Natural.$tcNatural (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep3 :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep3 = GHC.Types.KindRepFun $krep2 GHC.Types.krep$*
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$tcSigned1 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$tcSigned1 = "Signed"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$tcSigned2 :: GHC.Types.TrName
+[GblId, Unf=OtherCon []]
+$tcSigned2 = GHC.Types.TrNameS $tcSigned1
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoCastWW.$tcSigned :: GHC.Types.TyCon
+[GblId, Unf=OtherCon []]
+OpaqueNoCastWW.$tcSigned
+  = GHC.Types.TyCon
+      12374680438872388605##
+      16570143229152367467##
+      OpaqueNoCastWW.$trModule
+      $tcSigned2
+      0#
+      $krep3
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep4 :: [GHC.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep4
+  = GHC.Types.:
+      @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep5 :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep5 = GHC.Types.KindRepTyConApp OpaqueNoCastWW.$tcSigned $krep4
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep6 :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep6 = GHC.Types.KindRepFun $krep1 $krep5
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$tc'S1 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+$tc'S1 = "'S"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$tc'S2 :: GHC.Types.TrName
+[GblId, Unf=OtherCon []]
+$tc'S2 = GHC.Types.TrNameS $tc'S1
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoCastWW.$tc'S :: GHC.Types.TyCon
+[GblId, Unf=OtherCon []]
+OpaqueNoCastWW.$tc'S
+  = GHC.Types.TyCon
+      9801584576887380300##
+      5757617350287545124##
+      OpaqueNoCastWW.$trModule
+      $tc'S2
+      1#
+      $krep6
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.hs
new file mode 100644
index 0000000000..4728c03046
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.hs
@@ -0,0 +1,24 @@
+module OpaqueNoRebox where
+
+f :: (Int,Int) -> Int
+f (x,y) = x + y
+{-# OPAQUE f #-}
+
+-- No W/W happens for f because it is OPAQUE, and by design its Boxity
+-- information is stripped, which is good!
+--
+-- If we hadn't stripped the boxity information, we would make a worker
+-- for g that would just rebox its arguments:
+--
+--   $wg :: Int# -> Int# -> Int
+--   $wg ww ww1 =
+--     let x = I# ww in
+--     let y = I# ww1 in
+--     let p = (x,y) in
+--     case f (f p, f p) of { I# z -> ww +# z}
+--
+-- as $wg was expecting that a worker for f that would be inlined.
+--
+-- See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+g :: (Int, Int) -> Int
+g p = fst p + f (f p, f p)
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr
new file mode 100644
index 0000000000..ad82c9e16c
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox.stderr
@@ -0,0 +1,75 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 42, types: 35, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoRebox.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox.$trModule3
+  = GHC.Types.TrNameS OpaqueNoRebox.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 50 0}]
+OpaqueNoRebox.$trModule2 = "OpaqueNoRebox"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox.$trModule1
+  = GHC.Types.TrNameS OpaqueNoRebox.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox.$trModule
+  = GHC.Types.Module
+      OpaqueNoRebox.$trModule3 OpaqueNoRebox.$trModule1
+
+-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE] :: (Int, Int) -> Int
+[GblId, Arity=1, Str=<1P(1L,1L)>, Unf=OtherCon []]
+f = / (ds :: (Int, Int)) ->
+      case ds of { (x, y) -> GHC.Num.$fNumInt_$c+ x y }
+
+-- RHS size: {terms: 19, types: 14, coercions: 0, joins: 0/0}
+g [InlPrag=[2]] :: (Int, Int) -> Int
+[GblId,
+ Arity=1,
+ Str=<1P(SL,SL)>,
+ 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= / (p [Occ=Once1!] :: (Int, Int)) ->
+                 case p of wild { (x [Occ=Once1!], _ [Occ=Dead]) ->
+                 case x of { GHC.Types.I# x1 [Occ=Once1] ->
+                 case f (f wild, f wild) of { GHC.Types.I# y [Occ=Once1] ->
+                 GHC.Types.I# (GHC.Prim.+# x1 y)
+                 }
+                 }
+                 }}]
+g = / (p :: (Int, Int)) ->
+      case p of wild { (x, ds1) ->
+      case x of { GHC.Types.I# x1 ->
+      case f (f wild, f wild) of { GHC.Types.I# y ->
+      GHC.Types.I# (GHC.Prim.+# x1 y)
+      }
+      }
+      }
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.hs
new file mode 100644
index 0000000000..1384eea1d6
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.hs
@@ -0,0 +1,23 @@
+module OpaqueNoRebox2 where
+
+{-# OPAQUE f #-}
+f :: Int -> Int -> (Int, Int)
+f x y = (x,y)
+
+-- No W/W happens for f because it is OPAQUE, and by design its CPR
+-- information is stripped, which is good!
+--
+-- If we hadn't stripped the CPR information, we would make a worker/wrapper
+-- for g that would rebox the result of 'g':
+--
+--   $wg :: Bool -> Int -> (# Int, Int #)
+--   $wg True  a = case f 2 a of (x, y) -> (# x, y #)
+--   $wg False a = $wg True (a + 1)
+--
+--   g ds a = case $wg ds a of (# x, y#) -> (x, y)
+--
+-- as $wg was expecting that a worker for f that would be inlined.
+--
+-- See Note [The OPAQUE pragma and avoiding the reboxing of results]
+g True  a = f 2 a
+g False a = g True (a+1)
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.stderr
new file mode 100644
index 0000000000..a790f1047f
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox2.stderr
@@ -0,0 +1,66 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 42, types: 25, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 5, types: 4, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE] :: Int -> Int -> (Int, Int)
+[GblId, Arity=2, Str=<L><L>, Unf=OtherCon []]
+f = / (x :: Int) (y :: Int) -> (x, y)
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Int
+[GblId, Unf=OtherCon []]
+lvl = GHC.Types.I# 2#
+
+Rec {
+-- RHS size: {terms: 18, types: 5, coercions: 0, joins: 0/0}
+g [Occ=LoopBreaker] :: Bool -> Int -> (Int, Int)
+[GblId, Arity=2, Str=<1L><L>, Unf=OtherCon []]
+g = / (ds :: Bool) (a :: Int) ->
+      case ds of {
+        False ->
+          g GHC.Types.True
+            (case a of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) });
+        True -> f lvl a
+      }
+end Rec }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox2.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoRebox2.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox2.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox2.$trModule3
+  = GHC.Types.TrNameS OpaqueNoRebox2.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox2.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 50 0}]
+OpaqueNoRebox2.$trModule2 = "OpaqueNoRebox2"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox2.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox2.$trModule1
+  = GHC.Types.TrNameS OpaqueNoRebox2.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox2.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox2.$trModule
+  = GHC.Types.Module
+      OpaqueNoRebox2.$trModule3 OpaqueNoRebox2.$trModule1
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.hs
new file mode 100644
index 0000000000..887e40a432
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.hs
@@ -0,0 +1,43 @@
+module OpaqueNoRebox3 where
+
+f :: Int -> Int
+f x = x `seq` (x + 1)
+{-# OPAQUE f #-}
+
+-- Historical note:
+--
+-- Since no W/W happens for f because it is OPAQUE, currently, the worker for g
+-- does the dreaded reboxing of p similar to what is mentioned in
+-- https://gitlab.haskell.org/ghc/ghc/-/issues/13143
+--
+-- 16-Nov-2021, Sebastian Graf says:
+-- "Right, this is again not related to correct handling of OPAQUE but rather a
+-- weakness in boxity analysis at the moment. this is because when boxity
+-- analysis sees a  `Case`, it will look at its  `Alt`s. If one of the `Alt`
+-- says `Unboxed`, we let the `Unboxed` win. We'd only say Boxed if all the Alts
+-- had Boxed occs or if the scrutinee (or any of the occurrences that happen as
+-- part of the same trace, guaranteed) had a Boxed occ. It's kind of a necessary
+-- work-around until we have boxity analysis integrate with CPR analysis."
+--
+-- See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
+--
+-- 16-Mar-2022:
+-- With https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7609 merged, we no
+-- longer get a reboxing worker for g
+g :: Bool -> Bool -> Bool -> Int -> Int
+g = \w w1 w2 p ->
+  let fail_ = case w1 of
+              False -> case w2 of
+                 False -> g w True w2 p
+                 True  -> f (f p)
+              True -> error "patError"
+  in case w of
+        False -> case w1 of
+          False -> fail_
+          True -> case w2 of
+            False -> p + 1
+            True -> fail_
+        True -> case w1 of
+          False -> fail_
+          True -> case w2 of
+            _ -> f p
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr
new file mode 100644
index 0000000000..a74980ed99
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr
@@ -0,0 +1,161 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 120, types: 47, coercions: 4, joins: 1/1}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox3.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoRebox3.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox3.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox3.$trModule3
+  = GHC.Types.TrNameS OpaqueNoRebox3.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox3.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 50 0}]
+OpaqueNoRebox3.$trModule2 = "OpaqueNoRebox3"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox3.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox3.$trModule1
+  = GHC.Types.TrNameS OpaqueNoRebox3.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoRebox3.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoRebox3.$trModule
+  = GHC.Types.Module
+      OpaqueNoRebox3.$trModule3 OpaqueNoRebox3.$trModule1
+
+-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE] :: Int -> Int
+[GblId, Arity=1, Str=<1L>, Unf=OtherCon []]
+f = / (x :: Int) ->
+      case x of { GHC.Types.I# ipv -> GHC.Types.I# (GHC.Prim.+# ipv 1#) }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+lvl = "error"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl1 :: [Char]
+[GblId]
+lvl1 = GHC.CString.unpackCString# lvl
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl2 :: [Char]
+[GblId]
+lvl2 = GHC.CString.unpackCString# OpaqueNoRebox3.$trModule4
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl3 :: [Char]
+[GblId]
+lvl3 = GHC.CString.unpackCString# OpaqueNoRebox3.$trModule2
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl4 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+lvl4 = "OpaqueNoRebox3.hs"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl5 :: [Char]
+[GblId]
+lvl5 = GHC.CString.unpackCString# lvl4
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl6 :: Int
+[GblId, Unf=OtherCon []]
+lvl6 = GHC.Types.I# 33#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl7 :: Int
+[GblId, Unf=OtherCon []]
+lvl7 = GHC.Types.I# 23#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl8 :: Int
+[GblId, Unf=OtherCon []]
+lvl8 = GHC.Types.I# 28#
+
+-- RHS size: {terms: 8, types: 0, coercions: 0, joins: 0/0}
+lvl9 :: GHC.Stack.Types.SrcLoc
+[GblId, Unf=OtherCon []]
+lvl9 = GHC.Stack.Types.SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8
+
+-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
+lvl10 :: GHC.Stack.Types.CallStack
+[GblId, Unf=OtherCon []]
+lvl10
+  = GHC.Stack.Types.PushCallStack
+      lvl1 lvl9 GHC.Stack.Types.EmptyCallStack
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl11 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+lvl11 = "patError"#
+
+-- RHS size: {terms: 4, types: 2, coercions: 4, joins: 0/0}
+lvl12 :: Int
+[GblId, Str=b, Cpr=b]
+lvl12
+  = error
+      @GHC.Types.LiftedRep
+      @Int
+      (lvl10
+       `cast` (Sym (GHC.Classes.N:IP[0]
+                        <"callStack">_N <GHC.Stack.Types.CallStack>_N)
+               :: GHC.Stack.Types.CallStack
+                  ~R# (?callStack::GHC.Stack.Types.CallStack)))
+      (GHC.CString.unpackCString# lvl11)
+
+Rec {
+-- RHS size: {terms: 50, types: 13, coercions: 0, joins: 1/1}
+g [Occ=LoopBreaker] :: Bool -> Bool -> Bool -> Int -> Int
+[GblId, Arity=4, Str=<SL><SL><L><1L>, Unf=OtherCon []]
+g = / (w :: Bool) (w1 :: Bool) (w2 :: Bool) (p :: Int) ->
+      join {
+        fail_ [Dmd=M!P(L)] :: Int
+        [LclId[JoinId(0)(Nothing)]]
+        fail_
+          = case w1 of {
+              False ->
+                case w2 of {
+                  False -> g w GHC.Types.True GHC.Types.False p;
+                  True -> f (f p)
+                };
+              True -> lvl12
+            } } in
+      case w of {
+        False ->
+          case w1 of {
+            False -> jump fail_;
+            True ->
+              case w2 of {
+                False ->
+                  case p of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) };
+                True -> jump fail_
+              }
+          };
+        True ->
+          case w1 of {
+            False -> jump fail_;
+            True -> f p
+          }
+      }
+end Rec }
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.hs
new file mode 100644
index 0000000000..e0c1617923
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.hs
@@ -0,0 +1,12 @@
+module OpaqueNoSpecConstr where
+
+import GHC.Exts ( SpecConstrAnnotation(..) )
+
+data SPEC = SPEC | SPEC2
+{-# ANN type SPEC ForceSpecConstr #-}
+
+-- Would normally induce a SpecConstr on the constructors of SPEC
+loop :: SPEC -> [Int] -> [Int] -> [Int]
+loop SPEC z [] = z
+loop SPEC z (x:xs) = loop SPEC (x:z) xs
+{-# OPAQUE loop #-}
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.stderr
new file mode 100644
index 0000000000..e2a51a21b3
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecConstr.stderr
@@ -0,0 +1,172 @@
+
+==================== Simplified expression ====================
+GHC.Desugar.toAnnotationWrapper
+  @GHC.Exts.SpecConstrAnnotation
+  GHC.Exts.$fDataSpecConstrAnnotation
+  GHC.Exts.ForceSpecConstr
+
+
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 83, types: 40, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []]
+lvl = "OpaqueNoSpecConstr.hs:(10,1)-(11,39)|function loop"#
+
+-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
+lvl1 :: ()
+[GblId, Str=b, Cpr=b]
+lvl1 = Control.Exception.Base.patError @GHC.Types.LiftedRep @() lvl
+
+Rec {
+-- RHS size: {terms: 20, types: 13, coercions: 0, joins: 0/0}
+loop [InlPrag=OPAQUE, Occ=LoopBreaker]
+  :: SPEC -> [Int] -> [Int] -> [Int]
+[GblId, Arity=3, Str=<1L><L><1L>, Unf=OtherCon []]
+loop
+  = \ (ds :: SPEC) (z :: [Int]) (ds1 :: [Int]) ->
+      case ds of {
+        SPEC ->
+          case ds1 of {
+            [] -> z;
+            : x xs -> loop OpaqueNoSpecConstr.SPEC (GHC.Types.: @Int x z) xs
+          };
+        SPEC2 -> case lvl1 of wild1 { }
+      }
+end Rec }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoSpecConstr.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$trModule3
+  = GHC.Types.TrNameS OpaqueNoSpecConstr.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 60 0}]
+OpaqueNoSpecConstr.$trModule2 = "OpaqueNoSpecConstr"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$trModule1
+  = GHC.Types.TrNameS OpaqueNoSpecConstr.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$trModule
+  = GHC.Types.Module
+      OpaqueNoSpecConstr.$trModule3 OpaqueNoSpecConstr.$trModule1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tcSPEC2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoSpecConstr.$tcSPEC2 = "SPEC"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tcSPEC1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tcSPEC1
+  = GHC.Types.TrNameS OpaqueNoSpecConstr.$tcSPEC2
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tcSPEC :: GHC.Types.TyCon
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tcSPEC
+  = GHC.Types.TyCon
+      1794519131116102988##
+      1536993820726345194##
+      OpaqueNoSpecConstr.$trModule
+      OpaqueNoSpecConstr.$tcSPEC1
+      0#
+      GHC.Types.krep$*
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+OpaqueNoSpecConstr.$tc'SPEC1
+  = GHC.Types.KindRepTyConApp
+      OpaqueNoSpecConstr.$tcSPEC (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+OpaqueNoSpecConstr.$tc'SPEC4 = "'SPEC"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tc'SPEC3
+  = GHC.Types.TrNameS OpaqueNoSpecConstr.$tc'SPEC4
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC :: GHC.Types.TyCon
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tc'SPEC
+  = GHC.Types.TyCon
+      9648911419523887824##
+      4100179153648933145##
+      OpaqueNoSpecConstr.$trModule
+      OpaqueNoSpecConstr.$tc'SPEC3
+      0#
+      OpaqueNoSpecConstr.$tc'SPEC1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC6 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+OpaqueNoSpecConstr.$tc'SPEC6 = "'SPEC2"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC5 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tc'SPEC5
+  = GHC.Types.TrNameS OpaqueNoSpecConstr.$tc'SPEC6
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecConstr.$tc'SPEC2 :: GHC.Types.TyCon
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecConstr.$tc'SPEC2
+  = GHC.Types.TyCon
+      4214136204857816792##
+      17253701793498718125##
+      OpaqueNoSpecConstr.$trModule
+      OpaqueNoSpecConstr.$tc'SPEC5
+      0#
+      OpaqueNoSpecConstr.$tc'SPEC1
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.hs
new file mode 100644
index 0000000000..cc538980b1
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.hs
@@ -0,0 +1,7 @@
+module OpaqueNoSpecialise where
+
+f x = x : f (x-1)
+{-# OPAQUE f #-}
+
+-- This would normally induce a specialisation of f on Int
+g (x :: Int) = f x
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.stderr
new file mode 100644
index 0000000000..b3d76cde24
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoSpecialise.stderr
@@ -0,0 +1,74 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 41, types: 29, coercions: 0, joins: 0/2}
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Integer
+[GblId, Unf=OtherCon []]
+lvl = GHC.Num.Integer.IS 1#
+
+-- RHS size: {terms: 18, types: 12, coercions: 0, joins: 0/2}
+f [InlPrag=OPAQUE] :: forall {t}. Num t => t -> [t]
+[GblId,
+ Arity=2,
+ Str=<LP(A,LCL(C1(L)),A,A,A,A,MCM(L))><L>,
+ Unf=OtherCon []]
+f = \ (@t) ($dNum :: Num t) (eta :: t) ->
+      let {
+        lvl1 :: t
+        [LclId]
+        lvl1 = fromInteger @t $dNum lvl } in
+      letrec {
+        f1 [Occ=LoopBreaker, Dmd=SCS(L)] :: t -> [t]
+        [LclId, Arity=1, Str=<L>, Unf=OtherCon []]
+        f1 = \ (x :: t) -> GHC.Types.: @t x (f1 (- @t $dNum x lvl1)); } in
+      f1 eta
+
+-- RHS size: {terms: 4, types: 2, coercions: 0, joins: 0/0}
+g :: Int -> [Int]
+[GblId,
+ Arity=1,
+ Str=<L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
+g = \ (ds :: Int) -> f @Int GHC.Num.$fNumInt ds
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecialise.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoSpecialise.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecialise.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecialise.$trModule3
+  = GHC.Types.TrNameS OpaqueNoSpecialise.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecialise.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 60 0}]
+OpaqueNoSpecialise.$trModule2 = "OpaqueNoSpecialise"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecialise.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecialise.$trModule1
+  = GHC.Types.TrNameS OpaqueNoSpecialise.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoSpecialise.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoSpecialise.$trModule
+  = GHC.Types.Module
+      OpaqueNoSpecialise.$trModule3 OpaqueNoSpecialise.$trModule1
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.hs
new file mode 100644
index 0000000000..d4112cf12e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.hs
@@ -0,0 +1,5 @@
+module OpaqueNoStrictArgWW where
+
+f :: Int -> Int
+f x = x + 1
+{-# OPAQUE f #-}
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.stderr
new file mode 100644
index 0000000000..c99e729976
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoStrictArgWW.stderr
@@ -0,0 +1,49 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 23, types: 10, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoStrictArgWW.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoStrictArgWW.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoStrictArgWW.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoStrictArgWW.$trModule3
+  = GHC.Types.TrNameS OpaqueNoStrictArgWW.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoStrictArgWW.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 60 0}]
+OpaqueNoStrictArgWW.$trModule2 = "OpaqueNoStrictArgWW"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoStrictArgWW.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoStrictArgWW.$trModule1
+  = GHC.Types.TrNameS OpaqueNoStrictArgWW.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoStrictArgWW.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoStrictArgWW.$trModule
+  = GHC.Types.Module
+      OpaqueNoStrictArgWW.$trModule3 OpaqueNoStrictArgWW.$trModule1
+
+-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE] :: Int -> Int
+[GblId, Arity=1, Str=<1L>, Unf=OtherCon []]
+f = / (x :: Int) ->
+      case x of { GHC.Types.I# x1 -> GHC.Types.I# (GHC.Prim.+# x1 1#) }
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoWW.hs b/testsuite/tests/simplCore/should_compile/OpaqueNoWW.hs
new file mode 100644
index 0000000000..7d617e891f
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoWW.hs
@@ -0,0 +1,12 @@
+module OpaqueNoWW where
+
+-- Would normally result in a worker of type Int# -> Int#
+f :: Int -> Int
+f 0 = 0
+f x = f (x + 1)
+{-# OPAQUE f #-}
+
+g :: Bool -> Bool -> Int -> Int
+g True  True  p = f p
+g False True  p = p + 1
+g b     False p = g b True p
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoWW.stderr
new file mode 100644
index 0000000000..77d820f9dd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoWW.stderr
@@ -0,0 +1,78 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 65, types: 24, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoWW.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+OpaqueNoWW.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoWW.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoWW.$trModule3 = GHC.Types.TrNameS OpaqueNoWW.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoWW.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}]
+OpaqueNoWW.$trModule2 = "OpaqueNoWW"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoWW.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoWW.$trModule1 = GHC.Types.TrNameS OpaqueNoWW.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+OpaqueNoWW.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+OpaqueNoWW.$trModule
+  = GHC.Types.Module OpaqueNoWW.$trModule3 OpaqueNoWW.$trModule1
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl :: Int
+[GblId, Unf=OtherCon []]
+lvl = GHC.Types.I# 0#
+
+Rec {
+-- RHS size: {terms: 14, types: 4, coercions: 0, joins: 0/0}
+f [InlPrag=OPAQUE, Occ=LoopBreaker] :: Int -> Int
+[GblId, Arity=1, Str=<1P(1L)>, Unf=OtherCon []]
+f = / (ds :: Int) ->
+      case ds of { GHC.Types.I# ds1 ->
+      case ds1 of ds2 {
+        __DEFAULT -> f (GHC.Types.I# (GHC.Prim.+# ds2 1#));
+        0# -> lvl
+      }
+      }
+end Rec }
+
+Rec {
+-- RHS size: {terms: 32, types: 8, coercions: 0, joins: 0/0}
+g [Occ=LoopBreaker] :: Bool -> Bool -> Int -> Int
+[GblId, Arity=3, Str=<1L><1L><1L>, Unf=OtherCon []]
+g = / (ds :: Bool) (ds1 :: Bool) (p :: Int) ->
+      case ds of {
+        False ->
+          case ds1 of {
+            False -> g GHC.Types.False GHC.Types.True p;
+            True ->
+              case p of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }
+          };
+        True ->
+          case ds1 of {
+            False -> g GHC.Types.True GHC.Types.True p;
+            True -> f p
+          }
+      }
+end Rec }
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 034a76fadd..f0b361b3f8 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -379,3 +379,13 @@ test('T19790',  normal, compile, ['-O -ddump-rule-firings'])
 # -O0 is needed to trigger it because that switches rules off,
 # which (before the fix) lost crucial dependencies
 test('T20820',  normal, compile, ['-O0'])
+
+test('OpaqueNoAbsentArgWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoCastWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox2', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox3', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoSpecConstr', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoSpecialise', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoStrictArgWW', normal, compile, ['-O -fworker-wrapper-cbv -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])