Fix #11811.

Previously, I had forgotten to omit variables already in scope
from the TypeInType CUSK check. Simple enough to fix.

Test case: typecheck/should_compile/T11811

1 files changed, 18 insertions, 19 deletions

diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 89880422ea..ea7d036601 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -52,6 +52,7 @@ import Digraph          ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
+import Control.Arrow ( first )
 import Data.List ( sortBy )
 import Maybes( orElse, mapMaybe )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
@@ -801,7 +802,7 @@ rnTyFamDefltEqn :: Name
 rnTyFamDefltEqn cls (TyFamEqn { tfe_tycon = tycon
                               , tfe_pats  = tyvars
                               , tfe_rhs   = rhs })
-  = bindHsQTyVars ctx Nothing (Just cls) [] tyvars $ \ tyvars' ->
+  = bindHsQTyVars ctx Nothing (Just cls) [] tyvars $ \ tyvars' _ ->
     do { tycon'      <- lookupFamInstName (Just cls) tycon
        ; (rhs', fvs) <- rnLHsType ctx rhs
        ; return (TyFamEqn { tfe_tycon = tycon'
@@ -1251,7 +1252,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs })
        ; let doc = TySynCtx tycon
        ; traceRn (text "rntycl-ty" <+> ppr tycon <+> ppr kvs)
        ; ((tyvars', rhs'), fvs) <- bindHsQTyVars doc Nothing Nothing kvs tyvars $
-                                    \ tyvars' ->
+                                    \ tyvars' _ ->
                                     do { (rhs', fvs) <- rnTySyn doc rhs
                                        ; return ((tyvars', rhs'), fvs) }
        ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'
@@ -1265,9 +1266,11 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdDataDefn = defn
        ; let doc = TyDataCtx tycon
        ; traceRn (text "rntycl-data" <+> ppr tycon <+> ppr kvs)
        ; ((tyvars', defn', no_kvs), fvs)
-           <- bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' ->
-              do { ((defn', no_kvs), fvs) <- rnDataDefn doc defn
-                 ; return ((tyvars', defn', no_kvs), fvs) }
+           <- bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' dep_vars ->
+              do { ((defn', kind_sig_fvs), fvs) <- rnDataDefn doc defn
+                 ; let sig_tvs         = filterNameSet isTyVarName kind_sig_fvs
+                       unbound_sig_tvs = sig_tvs `minusNameSet` dep_vars
+                 ; return ((tyvars', defn', isEmptyNameSet unbound_sig_tvs), fvs) }
           -- See Note [Complete user-supplied kind signatures] in HsDecls
        ; typeintype <- xoptM LangExt.TypeInType
        ; let cusk = hsTvbAllKinded tyvars' &&
@@ -1287,7 +1290,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
 
         -- Tyvars scope over superclass context and method signatures
         ; ((tyvars', context', fds', ats'), stuff_fvs)
-            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \ tyvars' -> do
+            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \ tyvars' _ -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
              ; fds'  <- rnFds fds
@@ -1398,22 +1401,18 @@ orphanRoleAnnotErr (L loc decl)
             text "is declared.")
 
 rnDataDefn :: HsDocContext -> HsDataDefn RdrName
-           -> RnM ((HsDataDefn Name, Bool), FreeVars)
-                -- the Bool is True if the DataDefn is consistent with
-                -- having a CUSK. See Note [Complete user-supplied kind signatures]
-                -- in HsDecls
+           -> RnM ((HsDataDefn Name, NameSet), FreeVars)
+                -- the NameSet includes all Names free in the kind signature
+                -- See Note [Complete user-supplied kind signatures]
 rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                            , dd_ctxt = context, dd_cons = condecls
                            , dd_kindSig = m_sig, dd_derivs = derivs })
   = do  { checkTc (h98_style || null (unLoc context))
                   (badGadtStupidTheta doc)
 
-        ; (m_sig', cusk, sig_fvs) <- case m_sig of
-             Just sig -> do { fkvs <- freeKiTyVarsAllVars <$>
-                                      extractHsTyRdrTyVars sig
-                            ; (sig', fvs) <- rnLHsKind doc sig
-                            ; return (Just sig', null fkvs, fvs) }
-             Nothing  -> return (Nothing, True, emptyFVs)
+        ; (m_sig', sig_fvs) <- case m_sig of
+             Just sig -> first Just <$> rnLHsKind doc sig
+             Nothing  -> return (Nothing, emptyFVs)
         ; (context', fvs1) <- rnContext doc context
         ; (derivs',  fvs3) <- rn_derivs derivs
 
@@ -1433,7 +1432,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                                , dd_ctxt = context', dd_kindSig = m_sig'
                                , dd_cons = condecls'
                                , dd_derivs = derivs' }
-                  , cusk )
+                  , sig_fvs )
                  , all_fvs )
         }
   where
@@ -1464,7 +1463,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
        ; kvs <- extractRdrKindSigVars res_sig
        ; ((tyvars', res_sig', injectivity'), fv1) <-
             bindHsQTyVars doc Nothing mb_cls kvs tyvars $
-            \ tyvars'@(HsQTvs { hsq_implicit = rn_kvs }) ->
+            \ tyvars'@(HsQTvs { hsq_implicit = rn_kvs }) _ ->
             do { let rn_sig = rnFamResultSig doc rn_kvs
                ; (res_sig', fv_kind) <- wrapLocFstM rn_sig res_sig
                ; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')
@@ -1728,7 +1727,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
         ; (kvs, qtvs') <- get_con_qtvs (hsConDeclArgTys details)
 
         ; bindHsQTyVars doc (Just $ inHsDocContext doc) Nothing kvs qtvs' $
-          \new_tyvars -> do
+          \new_tyvars _ -> do
         { (new_context, fvs1) <- case mcxt of
                              Nothing   -> return (Nothing,emptyFVs)
                              Just lcxt -> do { (lctx',fvs) <- rnContext doc lcxt