Fix tyvar scoping within class SPECIALISE pragmas

Type variables from class/instance headers scope over class/instance
method type signatures, but DO NOT scope over the type signatures in
SPECIALISE and SPECIALISE instance pragmas.

The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for
SPECIALISE inline pragmas, but forgot to apply the same treatment
to method SPECIALISE pragmas, which lead to a Core Lint failure with
an out-of-scope type variable. This patch makes sure we apply the same
logic for both cases.

Fixes #22913

(cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11)

3 files changed, 58 insertions, 10 deletions

diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 68fe70b3fb..f0dad944aa 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -860,17 +860,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
 
        -- Rename the pragmas and signatures
        -- Annoyingly the type variables /are/ in scope for signatures, but
-       -- /are not/ in scope in the SPECIALISE instance pramas; e.g.
-       --    instance Eq a => Eq (T a) where
-       --       (==) :: a -> a -> a
-       --       {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
-       ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs
+       -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas.
+       -- See Note [Type variable scoping in SPECIALISE pragmas].
+       ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs
              bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds')
              sig_ctxt | is_cls_decl = ClsDeclCtxt cls
                       | otherwise   = InstDeclCtxt bound_nms
-       ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags
-       ; (other_sigs',      sig_fvs) <- bindLocalNamesFV ktv_names $
-                                        renameSigs sig_ctxt other_sigs
+       ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags
+       ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $
+                                      renameSigs sig_ctxt other_sigs
 
        -- Rename the bindings RHSs.  Again there's an issue about whether the
        -- type variables from the class/instance head are in scope.
@@ -881,8 +879,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
                                            emptyFVs binds_w_dus
                  ; return (mapBag fstOf3 binds_w_dus, bind_fvs) }
 
-       ; return ( binds'', spec_inst_prags' ++ other_sigs'
-                , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) }
+       ; return ( binds'', spec_prags' ++ other_sigs'
+                , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) }
+
+{- Note [Type variable scoping in SPECIALISE pragmas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When renaming the methods of a class or instance declaration, we must be careful
+with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance
+pragmas: the type variables from the class/instance header DO NOT scope over these,
+unlike class/instance method type signatures.
+
+Examples:
+
+  1. SPECIALISE
+
+    class C a where
+      meth :: a
+    instance C (Maybe a) where
+      meth = Nothing
+      {-# SPECIALISE INLINE meth :: Maybe [a] #-}
+
+  2. SPECIALISE instance
+
+    instance Eq a => Eq (T a) where
+       (==) :: a -> a -> a
+       {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
+
+  In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same
+  as the type variable `a` from the instance header.
+  For example, the SPECIALISE instance pragma above is a shorthand for
+
+      {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-}
+
+  which is alpha-equivalent to
+
+      {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-}
+
+  This shows that the type variables are not bound in the header.
+
+  Getting this scoping wrong can lead to out-of-scope type variable errors from
+  Core Lint, see e.g. #22913.
+-}
 
 rnMethodBindLHS :: Bool -> Name
                 -> LHsBindLR GhcPs GhcPs
diff --git a/testsuite/tests/rename/should_compile/T22913.hs b/testsuite/tests/rename/should_compile/T22913.hs
new file mode 100644
index 0000000000..a43ee28a9d
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22913.hs
@@ -0,0 +1,10 @@
+module T22913 where
+
+class FromSourceIO a where
+    fromSourceIO :: a
+instance FromSourceIO (Maybe o) where
+    fromSourceIO = undefined
+    {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-}
+ -- This SPECIALISE pragma caused a Core Lint error
+ -- due to incorrectly scoping the type variable 'o' from the instance header
+ -- over the SPECIALISE pragma.
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 71d631e499..965e80d760 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -178,3 +178,4 @@ test('T18497', [], makefile_test, ['T18497'])
 test('T18264', [], makefile_test, ['T18264'])
 test('T18302', expect_broken(18302), compile, [''])
 test('T17853', [], multimod_compile, ['T17853', '-v0'])
+test('T22913', normal, compile, [''])