Bring tcTyConScopedTyVars into scope in tcClassDecl2

It is possible that the type variables bound by a class header will map to
something different in the typechecker in the presence of
`StandaloneKindSignatures`. `tcClassDecl2` was not aware of this, however,
leading to #19738. To fix it, in `tcTyClDecls` we map each class `TcTyCon` to
its `tcTyConScopedTyVars` as a `ClassScopedTVEnv`. We then plumb that
`ClassScopedTVEnv` to `tcClassDecl2` where it can be used.

Fixes #19738.

1 files changed, 27 insertions, 12 deletions

diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 076c0c0ee0..b2b9f2c106 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -144,31 +144,35 @@ tcTyAndClassDecls :: [TyClGroup GhcRn]      -- Mutually-recursive groups in
                                             -- and their implicit Ids,DataCons
                          , [InstInfo GhcRn] -- Source-code instance decls info
                          , [DerivInfo]      -- Deriving info
+                         , ClassScopedTVEnv -- Class scoped type variables
                          )
 -- Fails if there are any errors
 tcTyAndClassDecls tyclds_s
   -- The code recovers internally, but if anything gave rise to
   -- an error we'd better stop now, to avoid a cascade
   -- Type check each group in dependency order folding the global env
-  = checkNoErrs $ fold_env [] [] tyclds_s
+  = checkNoErrs $ fold_env [] [] emptyNameEnv tyclds_s
   where
     fold_env :: [InstInfo GhcRn]
              -> [DerivInfo]
+             -> ClassScopedTVEnv
              -> [TyClGroup GhcRn]
-             -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])
-    fold_env inst_info deriv_info []
+             -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], ClassScopedTVEnv)
+    fold_env inst_info deriv_info class_scoped_tv_env []
       = do { gbl_env <- getGblEnv
-           ; return (gbl_env, inst_info, deriv_info) }
-    fold_env inst_info deriv_info (tyclds:tyclds_s)
-      = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds
+           ; return (gbl_env, inst_info, deriv_info, class_scoped_tv_env) }
+    fold_env inst_info deriv_info class_scoped_tv_env (tyclds:tyclds_s)
+      = do { (tcg_env, inst_info', deriv_info', class_scoped_tv_env')
+               <- tcTyClGroup tyclds
            ; setGblEnv tcg_env $
                -- remaining groups are typechecked in the extended global env.
              fold_env (inst_info' ++ inst_info)
                       (deriv_info' ++ deriv_info)
+                      (class_scoped_tv_env' `plusNameEnv` class_scoped_tv_env)
                       tyclds_s }
 
 tcTyClGroup :: TyClGroup GhcRn
-            -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])
+            -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], ClassScopedTVEnv)
 -- Typecheck one strongly-connected component of type, class, and instance decls
 -- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls
 tcTyClGroup (TyClGroup { group_tyclds = tyclds
@@ -180,7 +184,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
            -- Step 1: Typecheck the standalone kind signatures and type/class declarations
        ; traceTc "---- tcTyClGroup ---- {" empty
        ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds))
-       ; (tyclss, data_deriv_info, kindless) <-
+       ; (tyclss, data_deriv_info, class_scoped_tv_env, kindless) <-
            tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution]
            do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs
               ; tcTyClDecls tyclds kisig_env role_annots }
@@ -216,7 +220,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
        ; let deriv_info = datafam_deriv_info ++ data_deriv_info
        ; let gbl_env'' = gbl_env'
                 { tcg_ksigs = tcg_ksigs gbl_env' `unionNameSet` kindless }
-       ; return (gbl_env'', inst_info, deriv_info) }
+       ; return (gbl_env'', inst_info, deriv_info, class_scoped_tv_env) }
 
 -- Gives the kind for every TyCon that has a standalone kind signature
 type KindSigEnv = NameEnv Kind
@@ -225,7 +229,7 @@ tcTyClDecls
   :: [LTyClDecl GhcRn]
   -> KindSigEnv
   -> RoleAnnotEnv
-  -> TcM ([TyCon], [DerivInfo], NameSet)
+  -> TcM ([TyCon], [DerivInfo], ClassScopedTVEnv, NameSet)
 tcTyClDecls tyclds kisig_env role_annots
   = do {    -- Step 1: kind-check this group and returns the final
             -- (possibly-polymorphic) kind of each TyCon and Class
@@ -239,11 +243,12 @@ tcTyClDecls tyclds kisig_env role_annots
             -- NB: We have to be careful here to NOT eagerly unfold
             -- type synonyms, as we have not tested for type synonym
             -- loops yet and could fall into a black hole.
-       ; fixM $ \ ~(rec_tyclss, _, _) -> do
+       ; fixM $ \ ~(rec_tyclss, _, _, _) -> do
            { tcg_env <- getGblEnv
                  -- Forced so we don't retain a reference to the TcGblEnv
            ; let !src  = tcg_src tcg_env
                  roles = inferRoles src role_annots rec_tyclss
+                 class_scoped_tv_env = mk_class_scoped_tv_env tc_tycons
 
                  -- Populate environment with knot-tied ATyCon for TyCons
                  -- NB: if the decls mention any ill-staged data cons
@@ -260,7 +265,7 @@ tcTyClDecls tyclds kisig_env role_annots
 
                  -- Kind and type check declarations for this group
                mapAndUnzipM (tcTyClDecl roles) tyclds
-           ; return (tycons, concat data_deriv_infos, kindless)
+           ; return (tycons, concat data_deriv_infos, class_scoped_tv_env, kindless)
            } }
   where
     ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
@@ -268,6 +273,16 @@ tcTyClDecls tyclds kisig_env role_annots
                                   , ppr (tyConResKind tc)
                                   , ppr (isTcTyCon tc) ])
 
+    -- Map each class TcTyCon to their tcTyConScopedTyVars. This is ultimately
+    -- meant to be passed to GHC.Tc.TyCl.Class.tcClassDecl2, which consults
+    -- it when bringing type variables into scope over class method defaults.
+    -- See @Note [Scoped tyvars in a TcTyCon]@ in "GHC.Core.TyCon".
+    mk_class_scoped_tv_env :: [TcTyCon] -> ClassScopedTVEnv
+    mk_class_scoped_tv_env tc_tycons =
+      mkNameEnv [ (tyConName tc_tycon, tcTyConScopedTyVars tc_tycon)
+                | tc_tycon <- tc_tycons, tyConFlavour tc_tycon == ClassFlavour
+                ]
+
 zipRecTyClss :: [TcTyCon]
              -> [TyCon]           -- Knot-tied
              -> [(Name,TyThing)]