never executed always true always false
    1 
    2 {-# LANGUAGE FlexibleContexts    #-}
    3 {-# LANGUAGE ScopedTypeVariables #-}
    4 {-# LANGUAGE TypeFamilies        #-}
    5 
    6 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
    7 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
    8 
    9 {-
   10 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   11 
   12 Main pass of renamer
   13 -}
   14 
   15 module GHC.Rename.Module (
   16         rnSrcDecls, addTcgDUs, findSplice
   17     ) where
   18 
   19 import GHC.Prelude
   20 
   21 import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr )
   22 import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )
   23 
   24 import GHC.Hs
   25 import GHC.Types.Error
   26 import GHC.Types.FieldLabel
   27 import GHC.Types.Name.Reader
   28 import GHC.Rename.HsType
   29 import GHC.Rename.Bind
   30 import GHC.Rename.Env
   31 import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames
   32                         , checkDupRdrNamesN, bindLocalNamesFV
   33                         , checkShadowedRdrNames, warnUnusedTypePatterns
   34                         , newLocalBndrsRn
   35                         , withHsDocContext, noNestedForallsContextsErr
   36                         , addNoNestedForallsContextsErr, checkInferredVars )
   37 import GHC.Rename.Unbound ( mkUnboundName, notInScopeErr, WhereLooking(WL_Global) )
   38 import GHC.Rename.Names
   39 import GHC.Tc.Errors.Types
   40 import GHC.Tc.Gen.Annotation ( annCtxt )
   41 import GHC.Tc.Utils.Monad
   42 
   43 import GHC.Types.ForeignCall ( CCallTarget(..) )
   44 import GHC.Unit
   45 import GHC.Unit.Module.Warnings
   46 import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName
   47                         , monadClassName, returnMName, thenMName
   48                         , semigroupClassName, sappendName
   49                         , monoidClassName, mappendName
   50                         )
   51 import GHC.Types.Name
   52 import GHC.Types.Name.Set
   53 import GHC.Types.Name.Env
   54 import GHC.Types.Avail
   55 import GHC.Utils.Outputable
   56 import GHC.Data.Bag
   57 import GHC.Types.Basic  ( pprRuleName, TypeOrKind(..) )
   58 import GHC.Data.FastString
   59 import GHC.Types.SrcLoc as SrcLoc
   60 import GHC.Driver.Session
   61 import GHC.Utils.Misc   ( lengthExceeds, partitionWith )
   62 import GHC.Utils.Panic
   63 import GHC.Driver.Env ( HscEnv(..), hsc_home_unit)
   64 import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses )
   65 import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
   66                                , stronglyConnCompFromEdgedVerticesUniq )
   67 import GHC.Types.Unique.Set
   68 import GHC.Data.OrdList
   69 import qualified GHC.LanguageExtensions as LangExt
   70 
   71 import Control.Monad
   72 import Control.Arrow ( first )
   73 import Data.List ( mapAccumL )
   74 import qualified Data.List.NonEmpty as NE
   75 import Data.List.NonEmpty ( NonEmpty(..) )
   76 import Data.Maybe ( isNothing, fromMaybe, mapMaybe )
   77 import qualified Data.Set as Set ( difference, fromList, toList, null )
   78 import Data.Function ( on )
   79 
   80 {- | @rnSourceDecl@ "renames" declarations.
   81 It simultaneously performs dependency analysis and precedence parsing.
   82 It also does the following error checks:
   83 
   84 * Checks that tyvars are used properly. This includes checking
   85   for undefined tyvars, and tyvars in contexts that are ambiguous.
   86   (Some of this checking has now been moved to module @TcMonoType@,
   87   since we don't have functional dependency information at this point.)
   88 
   89 * Checks that all variable occurrences are defined.
   90 
   91 * Checks the @(..)@ etc constraints in the export list.
   92 
   93 Brings the binders of the group into scope in the appropriate places;
   94 does NOT assume that anything is in scope already
   95 -}
   96 rnSrcDecls :: HsGroup GhcPs -> RnM (TcGblEnv, HsGroup GhcRn)
   97 -- Rename a top-level HsGroup; used for normal source files *and* hs-boot files
   98 rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
   99                             hs_splcds  = splice_decls,
  100                             hs_tyclds  = tycl_decls,
  101                             hs_derivds = deriv_decls,
  102                             hs_fixds   = fix_decls,
  103                             hs_warnds  = warn_decls,
  104                             hs_annds   = ann_decls,
  105                             hs_fords   = foreign_decls,
  106                             hs_defds   = default_decls,
  107                             hs_ruleds  = rule_decls,
  108                             hs_docs    = docs })
  109  = do {
  110    -- (A) Process the top-level fixity declarations, creating a mapping from
  111    --     FastStrings to FixItems. Also checks for duplicates.
  112    --     See Note [Top-level fixity signatures in an HsGroup] in GHC.Hs.Decls
  113    local_fix_env <- makeMiniFixityEnv $ hsGroupTopLevelFixitySigs group ;
  114 
  115    -- (B) Bring top level binders (and their fixities) into scope,
  116    --     *except* for the value bindings, which get done in step (D)
  117    --     with collectHsIdBinders. However *do* include
  118    --
  119    --        * Class ops, data constructors, and record fields,
  120    --          because they do not have value declarations.
  121    --
  122    --        * For hs-boot files, include the value signatures
  123    --          Again, they have no value declarations
  124    --
  125    (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
  126 
  127 
  128    setEnvs tc_envs $ do {
  129 
  130    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
  131 
  132    -- (D1) Bring pattern synonyms into scope.
  133    --      Need to do this before (D2) because rnTopBindsLHS
  134    --      looks up those pattern synonyms (#9889)
  135 
  136    dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags ;
  137    has_sel <- xopt_FieldSelectors <$> getDynFlags ;
  138    extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env $ \pat_syn_bndrs -> do {
  139 
  140    -- (D2) Rename the left-hand sides of the value bindings.
  141    --     This depends on everything from (B) being in scope.
  142    --     It uses the fixity env from (A) to bind fixities for view patterns.
  143 
  144    -- We need to throw an error on such value bindings when in a boot file.
  145    is_boot <- tcIsHsBootOrSig ;
  146    new_lhs <- if is_boot
  147     then rnTopBindsLHSBoot local_fix_env val_decls
  148     else rnTopBindsLHS     local_fix_env val_decls ;
  149 
  150    -- Bind the LHSes (and their fixities) in the global rdr environment
  151    let { id_bndrs = collectHsIdBinders CollNoDictBinders new_lhs } ;
  152                     -- Excludes pattern-synonym binders
  153                     -- They are already in scope
  154    traceRn "rnSrcDecls" (ppr id_bndrs) ;
  155    tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;
  156    setEnvs tc_envs $ do {
  157 
  158    --  Now everything is in scope, as the remaining renaming assumes.
  159 
  160    -- (E) Rename type and class decls
  161    --     (note that value LHSes need to be in scope for default methods)
  162    --
  163    -- You might think that we could build proper def/use information
  164    -- for type and class declarations, but they can be involved
  165    -- in mutual recursion across modules, and we only do the SCC
  166    -- analysis for them in the type checker.
  167    -- So we content ourselves with gathering uses only; that
  168    -- means we'll only report a declaration as unused if it isn't
  169    -- mentioned at all.  Ah well.
  170    traceRn "Start rnTyClDecls" (ppr tycl_decls) ;
  171    (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ;
  172 
  173    -- (F) Rename Value declarations right-hand sides
  174    traceRn "Start rnmono" empty ;
  175    let { val_bndr_set = mkNameSet id_bndrs `unionNameSet` mkNameSet pat_syn_bndrs } ;
  176    (rn_val_decls, bind_dus) <- if is_boot
  177     -- For an hs-boot, use tc_bndrs (which collects how we're renamed
  178     -- signatures), since val_bndr_set is empty (there are no x = ...
  179     -- bindings in an hs-boot.)
  180     then rnTopBindsBoot tc_bndrs new_lhs
  181     else rnValBindsRHS (TopSigCtxt val_bndr_set) new_lhs ;
  182    traceRn "finish rnmono" (ppr rn_val_decls) ;
  183 
  184    -- (G) Rename Fixity and deprecations
  185 
  186    -- Rename fixity declarations and error if we try to
  187    -- fix something from another module (duplicates were checked in (A))
  188    let { all_bndrs = tc_bndrs `unionNameSet` val_bndr_set } ;
  189    rn_fix_decls <- mapM (mapM (rnSrcFixityDecl (TopSigCtxt all_bndrs)))
  190                         fix_decls ;
  191 
  192    -- Rename deprec decls;
  193    -- check for duplicates and ensure that deprecated things are defined locally
  194    -- at the moment, we don't keep these around past renaming
  195    rn_warns <- rnSrcWarnDecls all_bndrs warn_decls ;
  196 
  197    -- (H) Rename Everything else
  198 
  199    (rn_rule_decls,    src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $
  200                                    rnList rnHsRuleDecls rule_decls ;
  201                            -- Inside RULES, scoped type variables are on
  202    (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ;
  203    (rn_ann_decls,     src_fvs4) <- rnList rnAnnDecl       ann_decls ;
  204    (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl   default_decls ;
  205    (rn_deriv_decls,   src_fvs6) <- rnList rnSrcDerivDecl  deriv_decls ;
  206    (rn_splice_decls,  src_fvs7) <- rnList rnSpliceDecl    splice_decls ;
  207 
  208    last_tcg_env <- getGblEnv ;
  209    -- (I) Compute the results and return
  210    let {rn_group = HsGroup { hs_ext     = noExtField,
  211                              hs_valds   = rn_val_decls,
  212                              hs_splcds  = rn_splice_decls,
  213                              hs_tyclds  = rn_tycl_decls,
  214                              hs_derivds = rn_deriv_decls,
  215                              hs_fixds   = rn_fix_decls,
  216                              hs_warnds  = [], -- warns are returned in the tcg_env
  217                                              -- (see below) not in the HsGroup
  218                              hs_fords  = rn_foreign_decls,
  219                              hs_annds  = rn_ann_decls,
  220                              hs_defds  = rn_default_decls,
  221                              hs_ruleds = rn_rule_decls,
  222                              hs_docs   = docs } ;
  223 
  224         tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ;
  225         other_def  = (Just (mkNameSet tcf_bndrs), emptyNameSet) ;
  226         other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
  227                               src_fvs5, src_fvs6, src_fvs7] ;
  228                 -- It is tiresome to gather the binders from type and class decls
  229 
  230         src_dus = unitOL other_def `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
  231                 -- Instance decls may have occurrences of things bound in bind_dus
  232                 -- so we must put other_fvs last
  233 
  234         final_tcg_env = let tcg_env' = (last_tcg_env `addTcgDUs` src_dus)
  235                         in -- we return the deprecs in the env, not in the HsGroup above
  236                         tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
  237        } ;
  238    traceRn "finish rnSrc" (ppr rn_group) ;
  239    traceRn "finish Dus" (ppr src_dus ) ;
  240    return (final_tcg_env, rn_group)
  241                     }}}}
  242 
  243 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
  244 -- This function could be defined lower down in the module hierarchy,
  245 -- but there doesn't seem anywhere very logical to put it.
  246 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
  247 
  248 rnList :: (a -> RnM (b, FreeVars)) -> [LocatedA a] -> RnM ([LocatedA b], FreeVars)
  249 rnList f xs = mapFvRn (wrapLocFstMA f) xs
  250 
  251 {-
  252 *********************************************************
  253 *                                                       *
  254         Source-code deprecations declarations
  255 *                                                       *
  256 *********************************************************
  257 
  258 Check that the deprecated names are defined, are defined locally, and
  259 that there are no duplicate deprecations.
  260 
  261 It's only imported deprecations, dealt with in RnIfaces, that we
  262 gather them together.
  263 -}
  264 
  265 -- checks that the deprecations are defined locally, and that there are no duplicates
  266 rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM Warnings
  267 rnSrcWarnDecls _ []
  268   = return NoWarnings
  269 
  270 rnSrcWarnDecls bndr_set decls'
  271   = do { -- check for duplicates
  272        ; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = dups
  273                           in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
  274                warn_rdr_dups
  275        ; pairs_s <- mapM (addLocMA rn_deprec) decls
  276        ; return (WarnSome ((concat pairs_s))) }
  277  where
  278    decls = concatMap (wd_warnings . unLoc) decls'
  279 
  280    sig_ctxt = TopSigCtxt bndr_set
  281 
  282    rn_deprec (Warning _ rdr_names txt)
  283        -- ensures that the names are defined locally
  284      = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
  285                                 rdr_names
  286           ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
  287 
  288    what = text "deprecation"
  289 
  290    warn_rdr_dups = findDupRdrNames
  291                    $ concatMap (\(L _ (Warning _ ns _)) -> ns) decls
  292 
  293 findDupRdrNames :: [LocatedN RdrName] -> [NonEmpty (LocatedN RdrName)]
  294 findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
  295 
  296 -- look for duplicates among the OccNames;
  297 -- we check that the names are defined above
  298 -- invt: the lists returned by findDupsEq always have at least two elements
  299 
  300 {-
  301 *********************************************************
  302 *                                                      *
  303 \subsection{Annotation declarations}
  304 *                                                      *
  305 *********************************************************
  306 -}
  307 
  308 rnAnnDecl :: AnnDecl GhcPs -> RnM (AnnDecl GhcRn, FreeVars)
  309 rnAnnDecl ann@(HsAnnotation _ s provenance expr)
  310   = addErrCtxt (annCtxt ann) $
  311     do { (provenance', provenance_fvs) <- rnAnnProvenance provenance
  312        ; (expr', expr_fvs) <- setStage (Splice Untyped) $
  313                               rnLExpr expr
  314        ; return (HsAnnotation noAnn s provenance' expr',
  315                  provenance_fvs `plusFV` expr_fvs) }
  316 
  317 rnAnnProvenance :: AnnProvenance GhcPs
  318                 -> RnM (AnnProvenance GhcRn, FreeVars)
  319 rnAnnProvenance provenance = do
  320     provenance' <- case provenance of
  321       ValueAnnProvenance n -> ValueAnnProvenance
  322                           <$> lookupLocatedTopBndrRnN n
  323       TypeAnnProvenance n  -> TypeAnnProvenance
  324                           <$> lookupLocatedTopConstructorRnN n
  325       ModuleAnnProvenance  -> return ModuleAnnProvenance
  326     return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
  327 
  328 {-
  329 *********************************************************
  330 *                                                      *
  331 \subsection{Default declarations}
  332 *                                                      *
  333 *********************************************************
  334 -}
  335 
  336 rnDefaultDecl :: DefaultDecl GhcPs -> RnM (DefaultDecl GhcRn, FreeVars)
  337 rnDefaultDecl (DefaultDecl _ tys)
  338   = do { (tys', fvs) <- rnLHsTypes doc_str tys
  339        ; return (DefaultDecl noExtField tys', fvs) }
  340   where
  341     doc_str = DefaultDeclCtx
  342 
  343 {-
  344 *********************************************************
  345 *                                                      *
  346 \subsection{Foreign declarations}
  347 *                                                      *
  348 *********************************************************
  349 -}
  350 
  351 rnHsForeignDecl :: ForeignDecl GhcPs -> RnM (ForeignDecl GhcRn, FreeVars)
  352 rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
  353   = do { topEnv :: HscEnv <- getTopEnv
  354        ; name' <- lookupLocatedTopBndrRnN name
  355        ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
  356 
  357         -- Mark any PackageTarget style imports as coming from the current package
  358        ; let home_unit = hsc_home_unit topEnv
  359              spec'  = patchForeignImport (homeUnitAsUnit home_unit) spec
  360 
  361        ; return (ForeignImport { fd_i_ext = noExtField
  362                                , fd_name = name', fd_sig_ty = ty'
  363                                , fd_fi = spec' }, fvs) }
  364 
  365 rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
  366   = do { name' <- lookupLocatedOccRn name
  367        ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
  368        ; return (ForeignExport { fd_e_ext = noExtField
  369                                , fd_name = name', fd_sig_ty = ty'
  370                                , fd_fe = spec }
  371                 , fvs `addOneFV` unLoc name') }
  372         -- NB: a foreign export is an *occurrence site* for name, so
  373         --     we add it to the free-variable list.  It might, for example,
  374         --     be imported from another module
  375 
  376 -- | For Windows DLLs we need to know what packages imported symbols are from
  377 --      to generate correct calls. Imported symbols are tagged with the current
  378 --      package, so if they get inlined across a package boundary we'll still
  379 --      know where they're from.
  380 --
  381 patchForeignImport :: Unit -> ForeignImport -> ForeignImport
  382 patchForeignImport unit (CImport cconv safety fs spec src)
  383         = CImport cconv safety fs (patchCImportSpec unit spec) src
  384 
  385 patchCImportSpec :: Unit -> CImportSpec -> CImportSpec
  386 patchCImportSpec unit spec
  387  = case spec of
  388         CFunction callTarget    -> CFunction $ patchCCallTarget unit callTarget
  389         _                       -> spec
  390 
  391 patchCCallTarget :: Unit -> CCallTarget -> CCallTarget
  392 patchCCallTarget unit callTarget =
  393   case callTarget of
  394   StaticTarget src label Nothing isFun
  395                               -> StaticTarget src label (Just unit) isFun
  396   _                           -> callTarget
  397 
  398 {-
  399 *********************************************************
  400 *                                                      *
  401 \subsection{Instance declarations}
  402 *                                                      *
  403 *********************************************************
  404 -}
  405 
  406 rnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars)
  407 rnSrcInstDecl (TyFamInstD { tfid_inst = tfi })
  408   = do { (tfi', fvs) <- rnTyFamInstDecl (NonAssocTyFamEqn NotClosedTyFam) tfi
  409        ; return (TyFamInstD { tfid_ext = noExtField, tfid_inst = tfi' }, fvs) }
  410 
  411 rnSrcInstDecl (DataFamInstD { dfid_inst = dfi })
  412   = do { (dfi', fvs) <- rnDataFamInstDecl (NonAssocTyFamEqn NotClosedTyFam) dfi
  413        ; return (DataFamInstD { dfid_ext = noExtField, dfid_inst = dfi' }, fvs) }
  414 
  415 rnSrcInstDecl (ClsInstD { cid_inst = cid })
  416   = do { traceRn "rnSrcIstDecl {" (ppr cid)
  417        ; (cid', fvs) <- rnClsInstDecl cid
  418        ; traceRn "rnSrcIstDecl end }" empty
  419        ; return (ClsInstD { cid_d_ext = noExtField, cid_inst = cid' }, fvs) }
  420 
  421 -- | Warn about non-canonical typeclass instance declarations
  422 --
  423 -- A "non-canonical" instance definition can occur for instances of a
  424 -- class which redundantly defines an operation its superclass
  425 -- provides as well (c.f. `return`/`pure`). In such cases, a canonical
  426 -- instance is one where the subclass inherits its method
  427 -- implementation from its superclass instance (usually the subclass
  428 -- has a default method implementation to that effect). Consequently,
  429 -- a non-canonical instance occurs when this is not the case.
  430 --
  431 -- See also descriptions of 'checkCanonicalMonadInstances' and
  432 -- 'checkCanonicalMonoidInstances'
  433 checkCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM ()
  434 checkCanonicalInstances cls poly_ty mbinds = do
  435     whenWOptM Opt_WarnNonCanonicalMonadInstances
  436         $ checkCanonicalMonadInstances
  437         "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return"
  438 
  439     whenWOptM Opt_WarnNonCanonicalMonoidInstances
  440         $ checkCanonicalMonoidInstances
  441         "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid"
  442 
  443   where
  444     -- | Warn about unsound/non-canonical 'Applicative'/'Monad' instance
  445     -- declarations. Specifically, the following conditions are verified:
  446     --
  447     -- In 'Monad' instances declarations:
  448     --
  449     --  * If 'return' is overridden it must be canonical (i.e. @return = pure@)
  450     --  * If '(>>)' is overridden it must be canonical (i.e. @(>>) = (*>)@)
  451     --
  452     -- In 'Applicative' instance declarations:
  453     --
  454     --  * Warn if 'pure' is defined backwards (i.e. @pure = return@).
  455     --  * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@).
  456     --
  457     checkCanonicalMonadInstances refURL
  458       | cls == applicativeClassName =
  459           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $
  460               case mbind of
  461                   FunBind { fun_id = L _ name
  462                           , fun_matches = mg }
  463                       | name == pureAName, isAliasMG mg == Just returnMName
  464                       -> addWarnNonCanonicalMethod1 refURL
  465                             Opt_WarnNonCanonicalMonadInstances "pure" "return"
  466 
  467                       | name == thenAName, isAliasMG mg == Just thenMName
  468                       -> addWarnNonCanonicalMethod1 refURL
  469                             Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)"
  470 
  471                   _ -> return ()
  472 
  473       | cls == monadClassName =
  474           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $
  475               case mbind of
  476                   FunBind { fun_id = L _ name
  477                           , fun_matches = mg }
  478                       | name == returnMName, isAliasMG mg /= Just pureAName
  479                       -> addWarnNonCanonicalMethod2 refURL
  480                             Opt_WarnNonCanonicalMonadInstances "return" "pure"
  481 
  482                       | name == thenMName, isAliasMG mg /= Just thenAName
  483                       -> addWarnNonCanonicalMethod2 refURL
  484                             Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)"
  485 
  486                   _ -> return ()
  487 
  488       | otherwise = return ()
  489 
  490     -- | Check whether Monoid(mappend) is defined in terms of
  491     -- Semigroup((<>)) (and not the other way round). Specifically,
  492     -- the following conditions are verified:
  493     --
  494     -- In 'Monoid' instances declarations:
  495     --
  496     --  * If 'mappend' is overridden it must be canonical
  497     --    (i.e. @mappend = (<>)@)
  498     --
  499     -- In 'Semigroup' instance declarations:
  500     --
  501     --  * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@).
  502     --
  503     checkCanonicalMonoidInstances refURL
  504       | cls == semigroupClassName =
  505           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $
  506               case mbind of
  507                   FunBind { fun_id      = L _ name
  508                           , fun_matches = mg }
  509                       | name == sappendName, isAliasMG mg == Just mappendName
  510                       -> addWarnNonCanonicalMethod1 refURL
  511                             Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend"
  512 
  513                   _ -> return ()
  514 
  515       | cls == monoidClassName =
  516           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $
  517               case mbind of
  518                   FunBind { fun_id = L _ name
  519                           , fun_matches = mg }
  520                       | name == mappendName, isAliasMG mg /= Just sappendName
  521                       -> addWarnNonCanonicalMethod2 refURL
  522                             Opt_WarnNonCanonicalMonoidInstances
  523                             "mappend" "(<>)"
  524 
  525                   _ -> return ()
  526 
  527       | otherwise = return ()
  528 
  529     -- | test whether MatchGroup represents a trivial \"lhsName = rhsName\"
  530     -- binding, and return @Just rhsName@ if this is the case
  531     isAliasMG :: MatchGroup GhcRn (LHsExpr GhcRn) -> Maybe Name
  532     isAliasMG MG {mg_alts = (L _ [L _ (Match { m_pats = []
  533                                              , m_grhss = grhss })])}
  534         | GRHSs _ [L _ (GRHS _ [] body)] lbinds <- grhss
  535         , EmptyLocalBinds _ <- lbinds
  536         , HsVar _ lrhsName  <- unLoc body  = Just (unLoc lrhsName)
  537     isAliasMG _ = Nothing
  538 
  539     -- got "lhs = rhs" but expected something different
  540     addWarnNonCanonicalMethod1 refURL flag lhs rhs = do
  541         let dia = TcRnUnknownMessage $
  542               mkPlainDiagnostic (WarningWithFlag flag) noHints $
  543                 vcat [ text "Noncanonical" <+>
  544                        quotes (text (lhs ++ " = " ++ rhs)) <+>
  545                        text "definition detected"
  546                      , instDeclCtxt1 poly_ty
  547                      , text "Move definition from" <+>
  548                        quotes (text rhs) <+>
  549                        text "to" <+> quotes (text lhs)
  550                      , text "See also:" <+>
  551                        text refURL
  552                      ]
  553         addDiagnostic dia
  554 
  555     -- expected "lhs = rhs" but got something else
  556     addWarnNonCanonicalMethod2 refURL flag lhs rhs = do
  557         let dia = TcRnUnknownMessage $
  558               mkPlainDiagnostic (WarningWithFlag flag) noHints $
  559                 vcat [ text "Noncanonical" <+>
  560                        quotes (text lhs) <+>
  561                        text "definition detected"
  562                      , instDeclCtxt1 poly_ty
  563                      , quotes (text lhs) <+>
  564                        text "will eventually be removed in favour of" <+>
  565                        quotes (text rhs)
  566                      , text "Either remove definition for" <+>
  567                        quotes (text lhs) <+> text "(recommended)" <+>
  568                        text "or define as" <+>
  569                        quotes (text (lhs ++ " = " ++ rhs))
  570                      , text "See also:" <+>
  571                        text refURL
  572                      ]
  573         addDiagnostic dia
  574 
  575     -- stolen from GHC.Tc.TyCl.Instance
  576     instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
  577     instDeclCtxt1 hs_inst_ty
  578       = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))
  579 
  580     inst_decl_ctxt :: SDoc -> SDoc
  581     inst_decl_ctxt doc = hang (text "in the instance declaration for")
  582                          2 (quotes doc <> text ".")
  583 
  584 
  585 rnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars)
  586 rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
  587                            , cid_sigs = uprags, cid_tyfam_insts = ats
  588                            , cid_overlap_mode = oflag
  589                            , cid_datafam_insts = adts })
  590   = do { checkInferredVars ctxt inf_err inst_ty
  591        ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty
  592        ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
  593              -- Check if there are any nested `forall`s or contexts, which are
  594              -- illegal in the type of an instance declaration (see
  595              -- Note [No nested foralls or contexts in instance types] in
  596              -- GHC.Hs.Type)...
  597              mb_nested_msg = noNestedForallsContextsErr
  598                                (text "Instance head") head_ty'
  599              -- ...then check if the instance head is actually headed by a
  600              -- class type constructor...
  601              eith_cls = case hsTyGetAppHead_maybe head_ty' of
  602                Just (L _ cls) -> Right cls
  603                Nothing        -> Left
  604                  ( getLocA head_ty'
  605                  , hang (text "Illegal head of an instance declaration:"
  606                            <+> quotes (ppr head_ty'))
  607                       2 (vcat [ text "Instance heads must be of the form"
  608                               , nest 2 $ text "C ty_1 ... ty_n"
  609                               , text "where" <+> quotes (char 'C')
  610                                 <+> text "is a class"
  611                               ])
  612                  )
  613          -- ...finally, attempt to retrieve the class type constructor, failing
  614          -- with an error message if there isn't one. To avoid excessive
  615          -- amounts of error messages, we will only report one of the errors
  616          -- from mb_nested_msg or eith_cls at a time.
  617        ; cls <- case (mb_nested_msg, eith_cls) of
  618            (Nothing,   Right cls) -> pure cls
  619            (Just err1, _)         -> bail_out err1
  620            (_,         Left err2) -> bail_out err2
  621 
  622           -- Rename the bindings
  623           -- The typechecker (not the renamer) checks that all
  624           -- the bindings are for the right class
  625           -- (Slightly strangely) when scoped type variables are on, the
  626           -- forall-d tyvars scope over the method bindings too
  627        ; (mbinds', uprags', meth_fvs) <- rnMethodBinds False cls ktv_names mbinds uprags
  628 
  629        ; checkCanonicalInstances cls inst_ty' mbinds'
  630 
  631        -- Rename the associated types, and type signatures
  632        -- Both need to have the instance type variables in scope
  633        ; traceRn "rnSrcInstDecl" (ppr inst_ty' $$ ppr ktv_names)
  634        ; ((ats', adts'), more_fvs)
  635              <- bindLocalNamesFV ktv_names $
  636                 do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls ktv_names ats
  637                    ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls ktv_names adts
  638                    ; return ( (ats', adts'), at_fvs `plusFV` adt_fvs) }
  639 
  640        ; let all_fvs = meth_fvs `plusFV` more_fvs
  641                                 `plusFV` inst_fvs
  642        ; return (ClsInstDecl { cid_ext = noExtField
  643                              , cid_poly_ty = inst_ty', cid_binds = mbinds'
  644                              , cid_sigs = uprags', cid_tyfam_insts = ats'
  645                              , cid_overlap_mode = oflag
  646                              , cid_datafam_insts = adts' },
  647                  all_fvs) }
  648              -- We return the renamed associated data type declarations so
  649              -- that they can be entered into the list of type declarations
  650              -- for the binding group, but we also keep a copy in the instance.
  651              -- The latter is needed for well-formedness checks in the type
  652              -- checker (eg, to ensure that all ATs of the instance actually
  653              -- receive a declaration).
  654              -- NB: Even the copies in the instance declaration carry copies of
  655              --     the instance context after renaming.  This is a bit
  656              --     strange, but should not matter (and it would be more work
  657              --     to remove the context).
  658   where
  659     ctxt    = GenericCtx $ text "an instance declaration"
  660     inf_err = Just (text "Inferred type variables are not allowed")
  661 
  662     -- The instance is malformed. We'd still like to make *some* progress
  663     -- (rather than failing outright), so we report an error and continue for
  664     -- as long as we can. Importantly, this error should be thrown before we
  665     -- reach the typechecker, lest we encounter different errors that are
  666     -- hopelessly confusing (such as the one in #16114).
  667     bail_out (l, err_msg) = do
  668       addErrAt l $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg)
  669       pure $ mkUnboundName (mkTcOccFS (fsLit "<class>"))
  670 
  671 rnFamEqn :: HsDocContext
  672          -> AssocTyFamInfo
  673          -> FreeKiTyVars
  674          -- ^ Additional kind variables to implicitly bind if there is no
  675          --   explicit forall. (See the comments on @all_imp_vars@ below for a
  676          --   more detailed explanation.)
  677          -> FamEqn GhcPs rhs
  678          -> (HsDocContext -> rhs -> RnM (rhs', FreeVars))
  679          -> RnM (FamEqn GhcRn rhs', FreeVars)
  680 rnFamEqn doc atfi extra_kvars
  681     (FamEqn { feqn_tycon  = tycon
  682             , feqn_bndrs  = outer_bndrs
  683             , feqn_pats   = pats
  684             , feqn_fixity = fixity
  685             , feqn_rhs    = payload }) rn_payload
  686   = do { tycon' <- lookupFamInstName mb_cls tycon
  687 
  688          -- all_imp_vars represent the implicitly bound type variables. This is
  689          -- empty if we have an explicit `forall` (see
  690          -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means
  691          -- ignoring:
  692          --
  693          -- - pat_kity_vars, the free variables mentioned in the type patterns
  694          --   on the LHS of the equation, and
  695          -- - extra_kvars, which is one of the following:
  696          --   * For type family instances, extra_kvars are the free kind
  697          --     variables mentioned in an outermost kind signature on the RHS
  698          --     of the equation.
  699          --     (See Note [Implicit quantification in type synonyms] in
  700          --     GHC.Rename.HsType.)
  701          --   * For data family instances, extra_kvars are the free kind
  702          --     variables mentioned in the explicit return kind, if one is
  703          --     provided. (e.g., the `k` in `data instance T :: k -> Type`).
  704          --
  705          -- Some examples:
  706          --
  707          -- @
  708          -- type family F a b
  709          -- type instance forall a b c. F [(a, b)] c = a -> b -> c
  710          --   -- all_imp_vars = []
  711          -- type instance F [(a, b)] c = a -> b -> c
  712          --   -- all_imp_vars = [a, b, c]
  713          --
  714          -- type family G :: Maybe a
  715          -- type instance forall a. G = (Nothing :: Maybe a)
  716          --   -- all_imp_vars = []
  717          -- type instance G = (Nothing :: Maybe a)
  718          --   -- all_imp_vars = [a]
  719          --
  720          -- data family H :: k -> Type
  721          -- data instance forall k. H :: k -> Type where ...
  722          --   -- all_imp_vars = []
  723          -- data instance H :: k -> Type where ...
  724          --   -- all_imp_vars = [k]
  725          -- @
  726          --
  727          -- For associated type family instances, exclude the type variables
  728          -- bound by the instance head with filterInScopeM (#19649).
  729        ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars
  730 
  731        ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs ->
  732     do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats
  733        ; (payload', rhs_fvs) <- rn_payload doc payload
  734 
  735           -- Report unused binders on the LHS
  736           -- See Note [Unused type variables in family instances]
  737        ; let -- The SrcSpan that bindHsOuterFamEqnTyVarBndrs will attach to each
  738              -- implicitly bound type variable Name in outer_bndrs' will
  739              -- span the entire type family instance, which will be reflected in
  740              -- -Wunused-type-patterns warnings. We can be a little more precise
  741              -- than that by pointing to the LHS of the instance instead, which
  742              -- is what lhs_loc corresponds to.
  743              rn_outer_bndrs' = mapHsOuterImplicit (map (`setNameLoc` lhs_loc))
  744                                                   rn_outer_bndrs
  745 
  746              groups :: [NonEmpty (LocatedN RdrName)]
  747              groups = equivClasses cmpLocated pat_kity_vars
  748        ; nms_dups <- mapM (lookupOccRn . unLoc) $
  749                         [ tv | (tv :| (_:_)) <- groups ]
  750              -- Add to the used variables
  751              --  a) any variables that appear *more than once* on the LHS
  752              --     e.g.   F a Int a = Bool
  753              --  b) for associated instances, the variables
  754              --     of the instance decl.  See
  755              --     Note [Unused type variables in family instances]
  756        ; let nms_used = extendNameSetList rhs_fvs $
  757                            nms_dups {- (a) -} ++ inst_head_tvs {- (b) -}
  758              all_nms = hsOuterTyVarNames rn_outer_bndrs'
  759        ; warnUnusedTypePatterns all_nms nms_used
  760 
  761          -- For associated family instances, if a type variable from the
  762          -- parent instance declaration is mentioned on the RHS of the
  763          -- associated family instance but not bound on the LHS, then reject
  764          -- that type variable as being out of scope.
  765          -- See Note [Renaming associated types].
  766          -- Per that Note, the LHS type variables consist of:
  767          --
  768          -- - The variables mentioned in the instance's type patterns
  769          --   (pat_fvs), and
  770          --
  771          -- - The variables mentioned in an outermost kind signature on the
  772          --   RHS. This is a subset of `rhs_fvs`. To compute it, we look up
  773          --   each RdrName in `extra_kvars` to find its corresponding Name in
  774          --   the LocalRdrEnv.
  775        ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars
  776        ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms
  777              improperly_scoped cls_tkv =
  778                   cls_tkv `elemNameSet` rhs_fvs
  779                     -- Mentioned on the RHS...
  780                && not (cls_tkv `elemNameSet` lhs_bound_vars)
  781                     -- ...but not bound on the LHS.
  782              bad_tvs = filter improperly_scoped inst_head_tvs
  783        ; unless (null bad_tvs) (badAssocRhs bad_tvs)
  784 
  785        ; let eqn_fvs = rhs_fvs `plusFV` pat_fvs
  786              -- See Note [Type family equations and occurrences]
  787              all_fvs = case atfi of
  788                          NonAssocTyFamEqn ClosedTyFam
  789                            -> eqn_fvs
  790                          _ -> eqn_fvs `addOneFV` unLoc tycon'
  791 
  792        ; return (FamEqn { feqn_ext    = noAnn
  793                         , feqn_tycon  = tycon'
  794                           -- Note [Wildcards in family instances]
  795                         , feqn_bndrs  = rn_outer_bndrs'
  796                         , feqn_pats   = pats'
  797                         , feqn_fixity = fixity
  798                         , feqn_rhs    = payload' },
  799                  all_fvs) } }
  800   where
  801     -- The parent class, if we are dealing with an associated type family
  802     -- instance.
  803     mb_cls = case atfi of
  804       NonAssocTyFamEqn _   -> Nothing
  805       AssocTyFamDeflt cls  -> Just cls
  806       AssocTyFamInst cls _ -> Just cls
  807 
  808     -- The type variables from the instance head, if we are dealing with an
  809     -- associated type family instance.
  810     inst_head_tvs = case atfi of
  811       NonAssocTyFamEqn _             -> []
  812       AssocTyFamDeflt _              -> []
  813       AssocTyFamInst _ inst_head_tvs -> inst_head_tvs
  814 
  815     pat_kity_vars = extractHsTyArgRdrKiTyVars pats
  816              -- It is crucial that extractHsTyArgRdrKiTyVars return
  817              -- duplicate occurrences, since they're needed to help
  818              -- determine unused binders on the LHS.
  819 
  820     -- The SrcSpan of the LHS of the instance. For example, lhs_loc would be
  821     -- the highlighted part in the example below:
  822     --
  823     --   type instance F a b c = Either a b
  824     --                   ^^^^^
  825     lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of
  826       []         -> panic "rnFamEqn.lhs_loc"
  827       [loc]      -> loc
  828       (loc:locs) -> loc `combineSrcSpans` last locs
  829 
  830     badAssocRhs :: [Name] -> RnM ()
  831     badAssocRhs ns
  832       = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
  833            (hang (text "The RHS of an associated type declaration mentions"
  834                       <+> text "out-of-scope variable" <> plural ns
  835                       <+> pprWithCommas (quotes . ppr) ns)
  836                    2 (text "All such variables must be bound on the LHS"))
  837 
  838 rnTyFamInstDecl :: AssocTyFamInfo
  839                 -> TyFamInstDecl GhcPs
  840                 -> RnM (TyFamInstDecl GhcRn, FreeVars)
  841 rnTyFamInstDecl atfi (TyFamInstDecl { tfid_xtn = x, tfid_eqn = eqn })
  842   = do { (eqn', fvs) <- rnTyFamInstEqn atfi eqn
  843        ; return (TyFamInstDecl { tfid_xtn = x, tfid_eqn = eqn' }, fvs) }
  844 
  845 -- | Tracks whether we are renaming:
  846 --
  847 -- 1. A type family equation that is not associated
  848 --    with a parent type class ('NonAssocTyFamEqn'). Examples:
  849 --
  850 --    @
  851 --    type family F a
  852 --    type instance F Int = Bool  -- NonAssocTyFamEqn NotClosed
  853 --
  854 --    type family G a where
  855 --       G Int = Bool             -- NonAssocTyFamEqn Closed
  856 --    @
  857 --
  858 -- 2. An associated type family default declaration ('AssocTyFamDeflt').
  859 --    Example:
  860 --
  861 --    @
  862 --    class C a where
  863 --      type A a
  864 --      type instance A a = a -> a  -- AssocTyFamDeflt C
  865 --    @
  866 --
  867 -- 3. An associated type family instance declaration ('AssocTyFamInst').
  868 --    Example:
  869 --
  870 --    @
  871 --    instance C a => C [a] where
  872 --      type A [a] = Bool  -- AssocTyFamInst C [a]
  873 --    @
  874 data AssocTyFamInfo
  875   = NonAssocTyFamEqn
  876       ClosedTyFamInfo -- Is this a closed type family?
  877   | AssocTyFamDeflt
  878       Name            -- Name of the parent class
  879   | AssocTyFamInst
  880       Name            -- Name of the parent class
  881       [Name]          -- Names of the tyvars of the parent instance decl
  882 
  883 -- | Tracks whether we are renaming an equation in a closed type family
  884 -- equation ('ClosedTyFam') or not ('NotClosedTyFam').
  885 data ClosedTyFamInfo
  886   = NotClosedTyFam
  887   | ClosedTyFam
  888 
  889 rnTyFamInstEqn :: AssocTyFamInfo
  890                -> TyFamInstEqn GhcPs
  891                -> RnM (TyFamInstEqn GhcRn, FreeVars)
  892 rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs })
  893   = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn
  894   where
  895     extra_kvs = extractHsTyRdrTyVarsKindVars rhs
  896 
  897 rnTyFamDefltDecl :: Name
  898                  -> TyFamDefltDecl GhcPs
  899                  -> RnM (TyFamDefltDecl GhcRn, FreeVars)
  900 rnTyFamDefltDecl cls = rnTyFamInstDecl (AssocTyFamDeflt cls)
  901 
  902 rnDataFamInstDecl :: AssocTyFamInfo
  903                   -> DataFamInstDecl GhcPs
  904                   -> RnM (DataFamInstDecl GhcRn, FreeVars)
  905 rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn =
  906                     eqn@(FamEqn { feqn_tycon = tycon
  907                                 , feqn_rhs   = rhs })})
  908   = do { let extra_kvs = extractDataDefnKindVars rhs
  909        ; (eqn', fvs) <-
  910            rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn
  911        ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) }
  912 
  913 -- Renaming of the associated types in instances.
  914 
  915 -- Rename associated type family decl in class
  916 rnATDecls :: Name      -- Class
  917           -> [LFamilyDecl GhcPs]
  918           -> RnM ([LFamilyDecl GhcRn], FreeVars)
  919 rnATDecls cls at_decls
  920   = rnList (rnFamDecl (Just cls)) at_decls
  921 
  922 rnATInstDecls :: (AssocTyFamInfo ->           -- The function that renames
  923                   decl GhcPs ->               -- an instance. rnTyFamInstDecl
  924                   RnM (decl GhcRn, FreeVars)) -- or rnDataFamInstDecl
  925               -> Name      -- Class
  926               -> [Name]
  927               -> [LocatedA (decl GhcPs)]
  928               -> RnM ([LocatedA (decl GhcRn)], FreeVars)
  929 -- Used for data and type family defaults in a class decl
  930 -- and the family instance declarations in an instance
  931 --
  932 -- NB: We allow duplicate associated-type decls;
  933 --     See Note [Associated type instances] in GHC.Tc.TyCl.Instance
  934 rnATInstDecls rnFun cls tv_ns at_insts
  935   = rnList (rnFun (AssocTyFamInst cls tv_ns)) at_insts
  936     -- See Note [Renaming associated types]
  937 
  938 {- Note [Wildcards in family instances]
  939 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  940 Wild cards can be used in type/data family instance declarations to indicate
  941 that the name of a type variable doesn't matter. Each wild card will be
  942 replaced with a new unique type variable. For instance:
  943 
  944     type family F a b :: *
  945     type instance F Int _ = Int
  946 
  947 is the same as
  948 
  949     type family F a b :: *
  950     type instance F Int b = Int
  951 
  952 This is implemented as follows: Unnamed wildcards remain unchanged after
  953 the renamer, and then given fresh meta-variables during typechecking, and
  954 it is handled pretty much the same way as the ones in partial type signatures.
  955 We however don't want to emit hole constraints on wildcards in family
  956 instances, so we turn on PartialTypeSignatures and turn off warning flag to
  957 let typechecker know this.
  958 See related Note [Wildcards in visible kind application] in GHC.Tc.Gen.HsType
  959 
  960 Note [Unused type variables in family instances]
  961 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  962 When the flag -fwarn-unused-type-patterns is on, the compiler reports
  963 warnings about unused type variables in type-family instances. A
  964 tpye variable is considered used (i.e. cannot be turned into a wildcard)
  965 when
  966 
  967  * it occurs on the RHS of the family instance
  968    e.g.   type instance F a b = a    -- a is used on the RHS
  969 
  970  * it occurs multiple times in the patterns on the LHS
  971    e.g.   type instance F a a = Int  -- a appears more than once on LHS
  972 
  973  * it is one of the instance-decl variables, for associated types
  974    e.g.   instance C (a,b) where
  975             type T (a,b) = a
  976    Here the type pattern in the type instance must be the same as that
  977    for the class instance, so
  978             type T (a,_) = a
  979    would be rejected.  So we should not complain about an unused variable b
  980 
  981 As usual, the warnings are not reported for type variables with names
  982 beginning with an underscore.
  983 
  984 Extra-constraints wild cards are not supported in type/data family
  985 instance declarations.
  986 
  987 Relevant tickets: #3699, #10586, #10982 and #11451.
  988 
  989 Note [Renaming associated types]
  990 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  991 When renaming a type/data family instance, be it top-level or associated with
  992 a class, we must check that all of the type variables mentioned on the RHS are
  993 properly scoped. Specifically, the rule is this:
  994 
  995   Every variable mentioned on the RHS of a type instance declaration
  996   (whether associated or not) must be either
  997   * Mentioned on the LHS, or
  998   * Mentioned in an outermost kind signature on the RHS
  999     (see Note [Implicit quantification in type synonyms])
 1000 
 1001 Here is a simple example of something we should reject:
 1002 
 1003   class C a b where
 1004     type F a x
 1005   instance C Int Bool where
 1006     type F Int x = z
 1007 
 1008 Here, `z` is mentioned on the RHS of the associated instance without being
 1009 mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The
 1010 renamer will reject `z` as being out of scope without much fuss.
 1011 
 1012 Things get slightly trickier when the instance header itself binds type
 1013 variables. Consider this example (adapted from #5515):
 1014 
 1015    instance C (p,q) z where
 1016       type F (p,q) x = (x, z)
 1017 
 1018 According to the rule above, this instance is improperly scoped. However, due
 1019 to the way GHC's renamer works, `z` is /technically/ in scope, as GHC will
 1020 always bring type variables from an instance header into scope over the
 1021 associated type family instances. As a result, the renamer won't simply reject
 1022 the `z` as being out of scope (like it would for the `type F Int x = z`
 1023 example) unless further action is taken. It is important to reject this sort of
 1024 thing in the renamer, because if it is allowed to make it through to the
 1025 typechecker, unexpected shenanigans can occur (see #18021 for examples).
 1026 
 1027 To prevent these sorts of shenanigans, we reject programs like the one above
 1028 with an extra validity check in rnFamEqn. For each type variable bound in the
 1029 parent instance head, we check if it is mentioned on the RHS of the associated
 1030 family instance but not bound on the LHS. If any of the instance-head-bound
 1031 variables meet these criteria, we throw an error.
 1032 (See rnFamEqn.improperly_scoped for how this is implemented.)
 1033 
 1034 Some additional wrinkles:
 1035 
 1036 * This Note only applies to *instance* declarations.  In *class* declarations
 1037   there is no RHS to worry about, and the class variables can all be in scope
 1038   (#5862):
 1039 
 1040     class Category (x :: k -> k -> *) where
 1041       type Ob x :: k -> Constraint
 1042       id :: Ob x a => x a a
 1043       (.) :: (Ob x a, Ob x b, Ob x c) => x b c -> x a b -> x a c
 1044 
 1045   Here 'k' is in scope in the kind signature, just like 'x'.
 1046 
 1047 * Although type family equations can bind type variables with explicit foralls,
 1048   it need not be the case that all variables that appear on the RHS must be
 1049   bound by a forall. For instance, the following is acceptable:
 1050 
 1051     class C4 a where
 1052       type T4 a b
 1053     instance C4 (Maybe a) where
 1054       type forall b. T4 (Maybe a) b = Either a b
 1055 
 1056   Even though `a` is not bound by the forall, this is still accepted because `a`
 1057   was previously bound by the `instance C4 (Maybe a)` part. (see #16116).
 1058 
 1059 * In addition to the validity check in rnFamEqn.improperly_scoped, there is an
 1060   additional check in GHC.Tc.Validity.checkFamPatBinders that checks each family
 1061   instance equation for type variables used on the RHS but not bound on the
 1062   LHS. This is not made redundant by rmFamEqn.improperly_scoped, as there are
 1063   programs that each check will reject that the other check will not catch:
 1064 
 1065   - checkValidFamPats is used on all forms of family instances, whereas
 1066     rmFamEqn.improperly_scoped only checks associated family instances. Since
 1067     checkFamPatBinders occurs after typechecking, it can catch programs that
 1068     introduce dodgy scoping by way of type synonyms (see #7536), which is
 1069     impractical to accomplish in the renamer.
 1070   - rnFamEqn.improperly_scoped catches some programs that, if allowed to escape
 1071     the renamer, would accidentally be accepted by the typechecker. Here is one
 1072     such program (#18021):
 1073 
 1074       class C5 a where
 1075         data family D a
 1076 
 1077       instance forall a. C5 Int where
 1078         data instance D Int = MkD a
 1079 
 1080     If this is not rejected in the renamer, the typechecker would treat this
 1081     program as though the `a` were existentially quantified, like so:
 1082 
 1083       data instance D Int = forall a. MkD a
 1084 
 1085     This is likely not what the user intended!
 1086 
 1087     Here is another such program (#9574):
 1088 
 1089       class Funct f where
 1090         type Codomain f
 1091       instance Funct ('KProxy :: KProxy o) where
 1092         type Codomain 'KProxy = NatTr (Proxy :: o -> Type)
 1093 
 1094     Where:
 1095 
 1096       data Proxy (a :: k) = Proxy
 1097       data KProxy (t :: Type) = KProxy
 1098       data NatTr (c :: o -> Type)
 1099 
 1100     Note that the `o` in the `Codomain 'KProxy` instance should be considered
 1101     improperly scoped. It does not meet the criteria for being explicitly
 1102     quantified, as it is not mentioned by name on the LHS, nor does it meet the
 1103     criteria for being implicitly quantified, as it is used in a RHS kind
 1104     signature that is not outermost (see Note [Implicit quantification in type
 1105     synonyms]). However, `o` /is/ bound by the instance header, so if this
 1106     program is not rejected by the renamer, the typechecker would treat it as
 1107     though you had written this:
 1108 
 1109       instance Funct ('KProxy :: KProxy o) where
 1110         type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type)
 1111 
 1112     Although this is a valid program, it's probably a stretch too far to turn
 1113     `type Codomain 'KProxy = ...` into `type Codomain ('KProxy @o) = ...` here.
 1114     If the user really wants the latter, it is simple enough to communicate
 1115     their intent by mentioning `o` on the LHS by name.
 1116 
 1117 Note [Type family equations and occurrences]
 1118 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1119 In most data/type family equations, the type family name used in the equation
 1120 is treated as an occurrence. For example:
 1121 
 1122   module A where
 1123     type family F a
 1124 
 1125   module B () where
 1126     import B (F)
 1127     type instance F Int = Bool
 1128 
 1129 We do not want to warn about `F` being unused in the module `B`, as the
 1130 instance constitutes a use site for `F`. The exception to this rule is closed
 1131 type families, whose equations constitute a definition, not occurrences. For
 1132 example:
 1133 
 1134   module C () where
 1135     type family CF a where
 1136       CF Char = Float
 1137 
 1138 Here, we /do/ want to warn that `CF` is unused in the module `C`, as it is
 1139 defined but not used (#18470).
 1140 
 1141 GHC accomplishes this in rnFamEqn when determining the set of free
 1142 variables to return at the end. If renaming a data family or open type family
 1143 equation, we add the name of the type family constructor to the set of returned
 1144 free variables to ensure that the name is marked as an occurrence. If renaming
 1145 a closed type family equation, we avoid adding the type family constructor name
 1146 to the free variables. This is quite simple, but it is not a perfect solution.
 1147 Consider this example:
 1148 
 1149   module X () where
 1150     type family F a where
 1151       F Int = Bool
 1152       F Double = F Int
 1153 
 1154 At present, GHC will treat any use of a type family constructor on the RHS of a
 1155 type family equation as an occurrence. Since `F` is used on the RHS of the
 1156 second equation of `F`, it is treated as an occurrence, causing `F` not to be
 1157 warned about. This is not ideal, since `F` isn't exported—it really /should/
 1158 cause a warning to be emitted. There is some discussion in #10089/#12920 about
 1159 how this limitation might be overcome, but until then, we stick to the
 1160 simplistic solution above, as it fixes the egregious bug in #18470.
 1161 -}
 1162 
 1163 
 1164 {-
 1165 *********************************************************
 1166 *                                                      *
 1167 \subsection{Stand-alone deriving declarations}
 1168 *                                                      *
 1169 *********************************************************
 1170 -}
 1171 
 1172 rnSrcDerivDecl :: DerivDecl GhcPs -> RnM (DerivDecl GhcRn, FreeVars)
 1173 rnSrcDerivDecl (DerivDecl _ ty mds overlap)
 1174   = do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving
 1175        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
 1176        ; checkInferredVars ctxt inf_err nowc_ty
 1177        ; (mds', ty', fvs) <- rnLDerivStrategy ctxt mds $ rnHsSigWcType ctxt ty
 1178          -- Check if there are any nested `forall`s or contexts, which are
 1179          -- illegal in the type of an instance declaration (see
 1180          -- Note [No nested foralls or contexts in instance types] in
 1181          -- GHC.Hs.Type).
 1182        ; addNoNestedForallsContextsErr ctxt
 1183            (text "Standalone-derived instance head")
 1184            (getLHsInstDeclHead $ dropWildCards ty')
 1185        ; warnNoDerivStrat mds' loc
 1186        ; return (DerivDecl noAnn ty' mds' overlap, fvs) }
 1187   where
 1188     ctxt    = DerivDeclCtx
 1189     inf_err = Just (text "Inferred type variables are not allowed")
 1190     loc = getLocA nowc_ty
 1191     nowc_ty = dropWildCards ty
 1192 
 1193 standaloneDerivErr :: TcRnMessage
 1194 standaloneDerivErr
 1195   = TcRnUnknownMessage $ mkPlainError noHints $
 1196     hang (text "Illegal standalone deriving declaration")
 1197        2 (text "Use StandaloneDeriving to enable this extension")
 1198 
 1199 {-
 1200 *********************************************************
 1201 *                                                      *
 1202 \subsection{Rules}
 1203 *                                                      *
 1204 *********************************************************
 1205 -}
 1206 
 1207 rnHsRuleDecls :: RuleDecls GhcPs -> RnM (RuleDecls GhcRn, FreeVars)
 1208 rnHsRuleDecls (HsRules { rds_src = src
 1209                        , rds_rules = rules })
 1210   = do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules
 1211        ; return (HsRules { rds_ext = noExtField
 1212                          , rds_src = src
 1213                          , rds_rules = rn_rules }, fvs) }
 1214 
 1215 rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars)
 1216 rnHsRuleDecl (HsRule { rd_name = rule_name
 1217                      , rd_act  = act
 1218                      , rd_tyvs = tyvs
 1219                      , rd_tmvs = tmvs
 1220                      , rd_lhs  = lhs
 1221                      , rd_rhs  = rhs })
 1222   = do { let rdr_names_w_loc = map (get_var . unLoc) tmvs
 1223        ; checkDupRdrNamesN rdr_names_w_loc
 1224        ; checkShadowedRdrNames rdr_names_w_loc
 1225        ; names <- newLocalBndrsRn rdr_names_w_loc
 1226        ; let doc = RuleCtx (snd $ unLoc rule_name)
 1227        ; bindRuleTyVars doc tyvs $ \ tyvs' ->
 1228          bindRuleTmVars doc tyvs' tmvs names $ \ tmvs' ->
 1229     do { (lhs', fv_lhs') <- rnLExpr lhs
 1230        ; (rhs', fv_rhs') <- rnLExpr rhs
 1231        ; checkValidRule (snd $ unLoc rule_name) names lhs' fv_lhs'
 1232        ; return (HsRule { rd_ext  = HsRuleRn fv_lhs' fv_rhs'
 1233                         , rd_name = rule_name
 1234                         , rd_act  = act
 1235                         , rd_tyvs = tyvs'
 1236                         , rd_tmvs = tmvs'
 1237                         , rd_lhs  = lhs'
 1238                         , rd_rhs  = rhs' }, fv_lhs' `plusFV` fv_rhs') } }
 1239   where
 1240     get_var :: RuleBndr GhcPs -> LocatedN RdrName
 1241     get_var (RuleBndrSig _ v _) = v
 1242     get_var (RuleBndr _ v)      = v
 1243 
 1244 bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs
 1245                -> [LRuleBndr GhcPs] -> [Name]
 1246                -> ([LRuleBndr GhcRn] -> RnM (a, FreeVars))
 1247                -> RnM (a, FreeVars)
 1248 bindRuleTmVars doc tyvs vars names thing_inside
 1249   = go vars names $ \ vars' ->
 1250     bindLocalNamesFV names (thing_inside vars')
 1251   where
 1252     go ((L l (RuleBndr _ (L loc _))) : vars) (n : ns) thing_inside
 1253       = go vars ns $ \ vars' ->
 1254         thing_inside (L l (RuleBndr noAnn (L loc n)) : vars')
 1255 
 1256     go ((L l (RuleBndrSig _ (L loc _) bsig)) : vars)
 1257        (n : ns) thing_inside
 1258       = rnHsPatSigType bind_free_tvs doc bsig $ \ bsig' ->
 1259         go vars ns $ \ vars' ->
 1260         thing_inside (L l (RuleBndrSig noAnn (L loc n) bsig') : vars')
 1261 
 1262     go [] [] thing_inside = thing_inside []
 1263     go vars names _ = pprPanic "bindRuleVars" (ppr vars $$ ppr names)
 1264 
 1265     bind_free_tvs = case tyvs of Nothing -> AlwaysBind
 1266                                  Just _  -> NeverBind
 1267 
 1268 bindRuleTyVars :: HsDocContext -> Maybe [LHsTyVarBndr () GhcPs]
 1269                -> (Maybe [LHsTyVarBndr () GhcRn]  -> RnM (b, FreeVars))
 1270                -> RnM (b, FreeVars)
 1271 bindRuleTyVars doc (Just bndrs) thing_inside
 1272   = bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs (thing_inside . Just)
 1273 bindRuleTyVars _ _ thing_inside = thing_inside Nothing
 1274 
 1275 {-
 1276 Note [Rule LHS validity checking]
 1277 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1278 Check the shape of a rewrite rule LHS.  Currently we only allow
 1279 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 1280 @forall@'d variables.
 1281 
 1282 We used restrict the form of the 'ei' to prevent you writing rules
 1283 with LHSs with a complicated desugaring (and hence unlikely to match);
 1284 (e.g. a case expression is not allowed: too elaborate.)
 1285 
 1286 But there are legitimate non-trivial args ei, like sections and
 1287 lambdas.  So it seems simmpler not to check at all, and that is why
 1288 check_e is commented out.
 1289 -}
 1290 
 1291 checkValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM ()
 1292 checkValidRule rule_name ids lhs' fv_lhs'
 1293   = do  {       -- Check for the form of the LHS
 1294           case (validRuleLhs ids lhs') of
 1295                 Nothing  -> return ()
 1296                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
 1297 
 1298                 -- Check that LHS vars are all bound
 1299         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 1300         ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
 1301 
 1302 validRuleLhs :: [Name] -> LHsExpr GhcRn -> Maybe (HsExpr GhcRn)
 1303 -- Nothing => OK
 1304 -- Just e  => Not ok, and e is the offending sub-expression
 1305 validRuleLhs foralls lhs
 1306   = checkl lhs
 1307   where
 1308     checkl = check . unLoc
 1309 
 1310     check (OpApp _ e1 op e2)              = checkl op `mplus` checkl_e e1
 1311                                                       `mplus` checkl_e e2
 1312     check (HsApp _ e1 e2)                 = checkl e1 `mplus` checkl_e e2
 1313     check (HsAppType _ e _)               = checkl e
 1314     check (HsVar _ lv)
 1315       | (unLoc lv) `notElem` foralls      = Nothing
 1316     check other                           = Just other  -- Failure
 1317 
 1318         -- Check an argument
 1319     checkl_e _ = Nothing
 1320     -- Was (check_e e); see Note [Rule LHS validity checking]
 1321 
 1322 {-      Commented out; see Note [Rule LHS validity checking] above
 1323     check_e (HsVar v)     = Nothing
 1324     check_e (HsPar e)     = checkl_e e
 1325     check_e (HsLit e)     = Nothing
 1326     check_e (HsOverLit e) = Nothing
 1327 
 1328     check_e (OpApp e1 op _ e2)   = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
 1329     check_e (HsApp e1 e2)        = checkl_e e1 `mplus` checkl_e e2
 1330     check_e (NegApp e _)         = checkl_e e
 1331     check_e (ExplicitList _ es)  = checkl_es es
 1332     check_e other                = Just other   -- Fails
 1333 
 1334     checkl_es es = foldr (mplus . checkl_e) Nothing es
 1335 -}
 1336 
 1337 badRuleVar :: FastString -> Name -> TcRnMessage
 1338 badRuleVar name var
 1339   = TcRnUnknownMessage $ mkPlainError noHints $
 1340     sep [text "Rule" <+> doubleQuotes (ftext name) <> colon,
 1341          text "Forall'd variable" <+> quotes (ppr var) <+>
 1342                 text "does not appear on left hand side"]
 1343 
 1344 badRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> TcRnMessage
 1345 badRuleLhsErr name lhs bad_e
 1346   = TcRnUnknownMessage $ mkPlainError noHints $
 1347     sep [text "Rule" <+> pprRuleName name <> colon,
 1348          nest 2 (vcat [err,
 1349                        text "in left-hand side:" <+> ppr lhs])]
 1350     $$
 1351     text "LHS must be of form (f e1 .. en) where f is not forall'd"
 1352   where
 1353     err = case bad_e of
 1354             HsUnboundVar _ uv -> notInScopeErr WL_Global (mkRdrUnqual uv)
 1355             _                 -> text "Illegal expression:" <+> ppr bad_e
 1356 
 1357 {- **************************************************************
 1358          *                                                      *
 1359       Renaming type, class, instance and role declarations
 1360 *                                                               *
 1361 *****************************************************************
 1362 
 1363 @rnTyDecl@ uses the `global name function' to create a new type
 1364 declaration in which local names have been replaced by their original
 1365 names, reporting any unknown names.
 1366 
 1367 Renaming type variables is a pain. Because they now contain uniques,
 1368 it is necessary to pass in an association list which maps a parsed
 1369 tyvar to its @Name@ representation.
 1370 In some cases (type signatures of values),
 1371 it is even necessary to go over the type first
 1372 in order to get the set of tyvars used by it, make an assoc list,
 1373 and then go over it again to rename the tyvars!
 1374 However, we can also do some scoping checks at the same time.
 1375 
 1376 Note [Dependency analysis of type, class, and instance decls]
 1377 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1378 A TyClGroup represents a strongly connected components of
 1379 type/class/instance decls, together with the role annotations for the
 1380 type/class declarations.  The renamer uses strongly connected
 1381 comoponent analysis to build these groups.  We do this for a number of
 1382 reasons:
 1383 
 1384 * Improve kind error messages. Consider
 1385 
 1386      data T f a = MkT f a
 1387      data S f a = MkS f (T f a)
 1388 
 1389   This has a kind error, but the error message is better if you
 1390   check T first, (fixing its kind) and *then* S.  If you do kind
 1391   inference together, you might get an error reported in S, which
 1392   is jolly confusing.  See #4875
 1393 
 1394 
 1395 * Increase kind polymorphism.  See GHC.Tc.TyCl
 1396   Note [Grouping of type and class declarations]
 1397 
 1398 Why do the instance declarations participate?  At least two reasons
 1399 
 1400 * Consider (#11348)
 1401 
 1402      type family F a
 1403      type instance F Int = Bool
 1404 
 1405      data R = MkR (F Int)
 1406 
 1407      type Foo = 'MkR 'True
 1408 
 1409   For Foo to kind-check we need to know that (F Int) ~ Bool.  But we won't
 1410   know that unless we've looked at the type instance declaration for F
 1411   before kind-checking Foo.
 1412 
 1413 * Another example is this (#3990).
 1414 
 1415      data family Complex a
 1416      data instance Complex Double = CD {-# UNPACK #-} !Double
 1417                                        {-# UNPACK #-} !Double
 1418 
 1419      data T = T {-# UNPACK #-} !(Complex Double)
 1420 
 1421   Here, to generate the right kind of unpacked implementation for T,
 1422   we must have access to the 'data instance' declaration.
 1423 
 1424 * Things become more complicated when we introduce transitive
 1425   dependencies through imported definitions, like in this scenario:
 1426 
 1427       A.hs
 1428         type family Closed (t :: Type) :: Type where
 1429           Closed t = Open t
 1430 
 1431         type family Open (t :: Type) :: Type
 1432 
 1433       B.hs
 1434         data Q where
 1435           Q :: Closed Bool -> Q
 1436 
 1437         type instance Open Int = Bool
 1438 
 1439         type S = 'Q 'True
 1440 
 1441   Somehow, we must ensure that the instance Open Int = Bool is checked before
 1442   the type synonym S. While we know that S depends upon 'Q depends upon Closed,
 1443   we have no idea that Closed depends upon Open!
 1444 
 1445   To accommodate for these situations, we ensure that an instance is checked
 1446   before every @TyClDecl@ on which it does not depend. That's to say, instances
 1447   are checked as early as possible in @tcTyAndClassDecls@.
 1448 
 1449 ------------------------------------
 1450 So much for WHY.  What about HOW?  It's pretty easy:
 1451 
 1452 (1) Rename the type/class, instance, and role declarations
 1453     individually
 1454 
 1455 (2) Do strongly-connected component analysis of the type/class decls,
 1456     We'll make a TyClGroup for each SCC
 1457 
 1458     In this step we treat a reference to a (promoted) data constructor
 1459     K as a dependency on its parent type.  Thus
 1460         data T = K1 | K2
 1461         data S = MkS (Proxy 'K1)
 1462     Here S depends on 'K1 and hence on its parent T.
 1463 
 1464     In this step we ignore instances; see
 1465     Note [No dependencies on data instances]
 1466 
 1467 (3) Attach roles to the appropriate SCC
 1468 
 1469 (4) Attach instances to the appropriate SCC.
 1470     We add an instance decl to SCC when:
 1471       all its free types/classes are bound in this SCC or earlier ones
 1472 
 1473 (5) We make an initial TyClGroup, with empty group_tyclds, for any
 1474     (orphan) instances that affect only imported types/classes
 1475 
 1476 Steps (3) and (4) are done by the (mapAccumL mk_group) call.
 1477 
 1478 Note [No dependencies on data instances]
 1479 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1480 Consider this
 1481    data family D a
 1482    data instance D Int = D1
 1483    data S = MkS (Proxy 'D1)
 1484 
 1485 Here the declaration of S depends on the /data instance/ declaration
 1486 for 'D Int'.  That makes things a lot more complicated, especially
 1487 if the data instance is an associated type of an enclosing class instance.
 1488 (And the class instance might have several associated type instances
 1489 with different dependency structure!)
 1490 
 1491 Ugh.  For now we simply don't allow promotion of data constructors for
 1492 data instances.  See Note [AFamDataCon: not promoting data family
 1493 constructors] in GHC.Tc.Utils.Env
 1494 -}
 1495 
 1496 
 1497 rnTyClDecls :: [TyClGroup GhcPs]
 1498             -> RnM ([TyClGroup GhcRn], FreeVars)
 1499 -- Rename the declarations and do dependency analysis on them
 1500 rnTyClDecls tycl_ds
 1501   = do { -- Rename the type/class, instance, and role declaraations
 1502        ; tycls_w_fvs <- mapM (wrapLocFstMA rnTyClDecl) (tyClGroupTyClDecls tycl_ds)
 1503        ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs)
 1504        ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names (tyClGroupKindSigs tycl_ds)
 1505        ; instds_w_fvs <- mapM (wrapLocFstMA rnSrcInstDecl) (tyClGroupInstDecls tycl_ds)
 1506        ; role_annots  <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds)
 1507 
 1508        -- Do SCC analysis on the type/class decls
 1509        ; rdr_env <- getGlobalRdrEnv
 1510        ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs
 1511              role_annot_env = mkRoleAnnotEnv role_annots
 1512              (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs
 1513 
 1514              inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs
 1515              (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map
 1516 
 1517              first_group
 1518                | null init_inst_ds = []
 1519                | otherwise = [TyClGroup { group_ext    = noExtField
 1520                                         , group_tyclds = []
 1521                                         , group_kisigs = []
 1522                                         , group_roles  = []
 1523                                         , group_instds = init_inst_ds }]
 1524 
 1525              (final_inst_ds, groups)
 1526                 = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs
 1527 
 1528              all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs  `plusFV`
 1529                        foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV`
 1530                        foldr (plusFV . snd) emptyFVs kisigs_w_fvs
 1531 
 1532              all_groups = first_group ++ groups
 1533 
 1534        ; massertPpr (null final_inst_ds)
 1535                     (ppr instds_w_fvs
 1536                      $$ ppr inst_ds_map
 1537                      $$ ppr (flattenSCCs tycl_sccs)
 1538                      $$ ppr final_inst_ds)
 1539 
 1540        ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups)
 1541        ; return (all_groups, all_fvs) }
 1542   where
 1543     mk_group :: RoleAnnotEnv
 1544              -> KindSigEnv
 1545              -> InstDeclFreeVarsMap
 1546              -> SCC (LTyClDecl GhcRn)
 1547              -> (InstDeclFreeVarsMap, TyClGroup GhcRn)
 1548     mk_group role_env kisig_env inst_map scc
 1549       = (inst_map', group)
 1550       where
 1551         tycl_ds              = flattenSCC scc
 1552         bndrs                = map (tcdName . unLoc) tycl_ds
 1553         roles                = getRoleAnnots bndrs role_env
 1554         kisigs               = getKindSigs   bndrs kisig_env
 1555         (inst_ds, inst_map') = getInsts      bndrs inst_map
 1556         group = TyClGroup { group_ext    = noExtField
 1557                           , group_tyclds = tycl_ds
 1558                           , group_kisigs = kisigs
 1559                           , group_roles  = roles
 1560                           , group_instds = inst_ds }
 1561 
 1562 -- | Free variables of standalone kind signatures.
 1563 newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars)
 1564 
 1565 lookupKindSig_FV_Env :: KindSig_FV_Env -> Name -> FreeVars
 1566 lookupKindSig_FV_Env (KindSig_FV_Env e) name
 1567   = fromMaybe emptyFVs (lookupNameEnv e name)
 1568 
 1569 -- | Standalone kind signatures.
 1570 type KindSigEnv = NameEnv (LStandaloneKindSig GhcRn)
 1571 
 1572 mkKindSig_fv_env :: [(LStandaloneKindSig GhcRn, FreeVars)] -> (KindSigEnv, KindSig_FV_Env)
 1573 mkKindSig_fv_env kisigs_w_fvs = (kisig_env, kisig_fv_env)
 1574   where
 1575     kisig_env = mapNameEnv fst compound_env
 1576     kisig_fv_env = KindSig_FV_Env (mapNameEnv snd compound_env)
 1577     compound_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars)
 1578       = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs
 1579 
 1580 getKindSigs :: [Name] -> KindSigEnv -> [LStandaloneKindSig GhcRn]
 1581 getKindSigs bndrs kisig_env = mapMaybe (lookupNameEnv kisig_env) bndrs
 1582 
 1583 rnStandaloneKindSignatures
 1584   :: NameSet  -- names of types and classes in the current TyClGroup
 1585   -> [LStandaloneKindSig GhcPs]
 1586   -> RnM [(LStandaloneKindSig GhcRn, FreeVars)]
 1587 rnStandaloneKindSignatures tc_names kisigs
 1588   = do { let (no_dups, dup_kisigs) = removeDups (compare `on` get_name) kisigs
 1589              get_name = standaloneKindSigName . unLoc
 1590        ; mapM_ dupKindSig_Err dup_kisigs
 1591        ; mapM (wrapLocFstMA (rnStandaloneKindSignature tc_names)) no_dups
 1592        }
 1593 
 1594 rnStandaloneKindSignature
 1595   :: NameSet  -- names of types and classes in the current TyClGroup
 1596   -> StandaloneKindSig GhcPs
 1597   -> RnM (StandaloneKindSig GhcRn, FreeVars)
 1598 rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki)
 1599   = do  { standalone_ki_sig_ok <- xoptM LangExt.StandaloneKindSignatures
 1600         ; unless standalone_ki_sig_ok $ addErr standaloneKiSigErr
 1601         ; new_v <- lookupSigCtxtOccRnN (TopSigCtxt tc_names) (text "standalone kind signature") v
 1602         ; let doc = StandaloneKindSigCtx (ppr v)
 1603         ; (new_ki, fvs) <- rnHsSigType doc KindLevel ki
 1604         ; return (StandaloneKindSig noExtField new_v new_ki, fvs)
 1605         }
 1606   where
 1607     standaloneKiSigErr :: TcRnMessage
 1608     standaloneKiSigErr = TcRnUnknownMessage $ mkPlainError noHints $
 1609       hang (text "Illegal standalone kind signature")
 1610          2 (text "Did you mean to enable StandaloneKindSignatures?")
 1611 
 1612 depAnalTyClDecls :: GlobalRdrEnv
 1613                  -> KindSig_FV_Env
 1614                  -> [(LTyClDecl GhcRn, FreeVars)]
 1615                  -> [SCC (LTyClDecl GhcRn)]
 1616 -- See Note [Dependency analysis of type, class, and instance decls]
 1617 depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
 1618   = stronglyConnCompFromEdgedVerticesUniq edges
 1619   where
 1620     edges :: [ Node Name (LTyClDecl GhcRn) ]
 1621     edges = [ DigraphNode d name (map (getParent rdr_env) (nonDetEltsUniqSet deps))
 1622             | (d, fvs) <- ds_w_fvs,
 1623               let { name = tcdName (unLoc d)
 1624                   ; kisig_fvs = lookupKindSig_FV_Env kisig_fv_env name
 1625                   ; deps = fvs `plusFV` kisig_fvs
 1626                   }
 1627             ]
 1628             -- It's OK to use nonDetEltsUFM here as
 1629             -- stronglyConnCompFromEdgedVertices is still deterministic
 1630             -- even if the edges are in nondeterministic order as explained
 1631             -- in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
 1632 
 1633 toParents :: GlobalRdrEnv -> NameSet -> NameSet
 1634 toParents rdr_env ns
 1635   = nonDetStrictFoldUniqSet add emptyNameSet ns
 1636   -- It's OK to use a non-deterministic fold because we immediately forget the
 1637   -- ordering by creating a set
 1638   where
 1639     add n s = extendNameSet s (getParent rdr_env n)
 1640 
 1641 getParent :: GlobalRdrEnv -> Name -> Name
 1642 getParent rdr_env n
 1643   = case lookupGRE_Name rdr_env n of
 1644       Just gre -> case gre_par gre of
 1645                     ParentIs  { par_is = p } -> p
 1646                     _                        -> n
 1647       Nothing -> n
 1648 
 1649 
 1650 {- ******************************************************
 1651 *                                                       *
 1652        Role annotations
 1653 *                                                       *
 1654 ****************************************************** -}
 1655 
 1656 -- | Renames role annotations, returning them as the values in a NameEnv
 1657 -- and checks for duplicate role annotations.
 1658 -- It is quite convenient to do both of these in the same place.
 1659 -- See also Note [Role annotations in the renamer]
 1660 rnRoleAnnots :: NameSet
 1661              -> [LRoleAnnotDecl GhcPs]
 1662              -> RnM [LRoleAnnotDecl GhcRn]
 1663 rnRoleAnnots tc_names role_annots
 1664   = do {  -- Check for duplicates *before* renaming, to avoid
 1665           -- lumping together all the unboundNames
 1666          let (no_dups, dup_annots) = removeDups (compare `on` get_name) role_annots
 1667              get_name = roleAnnotDeclName . unLoc
 1668        ; mapM_ dupRoleAnnotErr dup_annots
 1669        ; mapM (wrapLocMA rn_role_annot1) no_dups }
 1670   where
 1671     rn_role_annot1 (RoleAnnotDecl _ tycon roles)
 1672       = do {  -- the name is an *occurrence*, but look it up only in the
 1673               -- decls defined in this group (see #10263)
 1674              tycon' <- lookupSigCtxtOccRnN (RoleAnnotCtxt tc_names)
 1675                                            (text "role annotation")
 1676                                            tycon
 1677            ; return $ RoleAnnotDecl noExtField tycon' roles }
 1678 
 1679 dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM ()
 1680 dupRoleAnnotErr list
 1681   = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $
 1682     hang (text "Duplicate role annotations for" <+>
 1683           quotes (ppr $ roleAnnotDeclName first_decl) <> colon)
 1684        2 (vcat $ map pp_role_annot $ NE.toList sorted_list)
 1685     where
 1686       sorted_list = NE.sortBy cmp_loc list
 1687       ((L loc first_decl) :| _) = sorted_list
 1688 
 1689       pp_role_annot (L loc decl) = hang (ppr decl)
 1690                                       4 (text "-- written at" <+> ppr (locA loc))
 1691 
 1692       cmp_loc = SrcLoc.leftmost_smallest `on` getLocA
 1693 
 1694 dupKindSig_Err :: NonEmpty (LStandaloneKindSig GhcPs) -> RnM ()
 1695 dupKindSig_Err list
 1696   = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $
 1697     hang (text "Duplicate standalone kind signatures for" <+>
 1698           quotes (ppr $ standaloneKindSigName first_decl) <> colon)
 1699        2 (vcat $ map pp_kisig $ NE.toList sorted_list)
 1700     where
 1701       sorted_list = NE.sortBy cmp_loc list
 1702       ((L loc first_decl) :| _) = sorted_list
 1703 
 1704       pp_kisig (L loc decl) =
 1705         hang (ppr decl) 4 (text "-- written at" <+> ppr (locA loc))
 1706 
 1707       cmp_loc = SrcLoc.leftmost_smallest `on` getLocA
 1708 
 1709 {- Note [Role annotations in the renamer]
 1710 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1711 We must ensure that a type's role annotation is put in the same group as the
 1712 proper type declaration. This is because role annotations are needed during
 1713 type-checking when creating the type's TyCon. So, rnRoleAnnots builds a
 1714 NameEnv (LRoleAnnotDecl Name) that maps a name to a role annotation for that
 1715 type, if any. Then, this map can be used to add the role annotations to the
 1716 groups after dependency analysis.
 1717 
 1718 This process checks for duplicate role annotations, where we must be careful
 1719 to do the check *before* renaming to avoid calling all unbound names duplicates
 1720 of one another.
 1721 
 1722 The renaming process, as usual, might identify and report errors for unbound
 1723 names. This is done by using lookupSigCtxtOccRn in rnRoleAnnots (using
 1724 lookupGlobalOccRn led to #8485).
 1725 -}
 1726 
 1727 
 1728 {- ******************************************************
 1729 *                                                       *
 1730        Dependency info for instances
 1731 *                                                       *
 1732 ****************************************************** -}
 1733 
 1734 ----------------------------------------------------------
 1735 -- | 'InstDeclFreeVarsMap is an association of an
 1736 --   @InstDecl@ with @FreeVars@. The @FreeVars@ are
 1737 --   the tycon names that are both
 1738 --     a) free in the instance declaration
 1739 --     b) bound by this group of type/class/instance decls
 1740 type InstDeclFreeVarsMap = [(LInstDecl GhcRn, FreeVars)]
 1741 
 1742 -- | Construct an @InstDeclFreeVarsMap@ by eliminating any @Name@s from the
 1743 --   @FreeVars@ which are *not* the binders of a @TyClDecl@.
 1744 mkInstDeclFreeVarsMap :: GlobalRdrEnv
 1745                       -> NameSet
 1746                       -> [(LInstDecl GhcRn, FreeVars)]
 1747                       -> InstDeclFreeVarsMap
 1748 mkInstDeclFreeVarsMap rdr_env tycl_bndrs inst_ds_fvs
 1749   = [ (inst_decl, toParents rdr_env fvs `intersectFVs` tycl_bndrs)
 1750     | (inst_decl, fvs) <- inst_ds_fvs ]
 1751 
 1752 -- | Get the @LInstDecl@s which have empty @FreeVars@ sets, and the
 1753 --   @InstDeclFreeVarsMap@ with these entries removed.
 1754 -- We call (getInsts tcs instd_map) when we've completed the declarations
 1755 -- for 'tcs'.  The call returns (inst_decls, instd_map'), where
 1756 --   inst_decls are the instance declarations all of
 1757 --              whose free vars are now defined
 1758 --   instd_map' is the inst-decl map with 'tcs' removed from
 1759 --               the free-var set
 1760 getInsts :: [Name] -> InstDeclFreeVarsMap
 1761          -> ([LInstDecl GhcRn], InstDeclFreeVarsMap)
 1762 getInsts bndrs inst_decl_map
 1763   = partitionWith pick_me inst_decl_map
 1764   where
 1765     pick_me :: (LInstDecl GhcRn, FreeVars)
 1766             -> Either (LInstDecl GhcRn) (LInstDecl GhcRn, FreeVars)
 1767     pick_me (decl, fvs)
 1768       | isEmptyNameSet depleted_fvs = Left decl
 1769       | otherwise                   = Right (decl, depleted_fvs)
 1770       where
 1771         depleted_fvs = delFVs bndrs fvs
 1772 
 1773 {- ******************************************************
 1774 *                                                       *
 1775          Renaming a type or class declaration
 1776 *                                                       *
 1777 ****************************************************** -}
 1778 
 1779 rnTyClDecl :: TyClDecl GhcPs
 1780            -> RnM (TyClDecl GhcRn, FreeVars)
 1781 
 1782 -- All flavours of top-level type family declarations ("type family", "newtype
 1783 -- family", and "data family")
 1784 rnTyClDecl (FamDecl { tcdFam = fam })
 1785   = do { (fam', fvs) <- rnFamDecl Nothing fam
 1786        ; return (FamDecl noExtField fam', fvs) }
 1787 
 1788 rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
 1789                       tcdFixity = fixity, tcdRhs = rhs })
 1790   = do { tycon' <- lookupLocatedTopConstructorRnN tycon
 1791        ; let kvs = extractHsTyRdrTyVarsKindVars rhs
 1792              doc = TySynCtx tycon
 1793        ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs)
 1794        ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ ->
 1795     do { (rhs', fvs) <- rnTySyn doc rhs
 1796        ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'
 1797                          , tcdFixity = fixity
 1798                          , tcdRhs = rhs', tcdSExt = fvs }, fvs) } }
 1799 
 1800 -- "data", "newtype" declarations
 1801 rnTyClDecl (DataDecl
 1802     { tcdLName = tycon, tcdTyVars = tyvars,
 1803       tcdFixity = fixity,
 1804       tcdDataDefn = defn@HsDataDefn{ dd_ND = new_or_data
 1805                                    , dd_kindSig = kind_sig} })
 1806   = do { tycon' <- lookupLocatedTopConstructorRnN tycon
 1807        ; let kvs = extractDataDefnKindVars defn
 1808              doc = TyDataCtx tycon
 1809        ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs)
 1810        ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs ->
 1811     do { (defn', fvs) <- rnDataDefn doc defn
 1812        ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig
 1813        ; let rn_info = DataDeclRn { tcdDataCusk = cusk
 1814                                   , tcdFVs      = fvs }
 1815        ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs)
 1816        ; return (DataDecl { tcdLName    = tycon'
 1817                           , tcdTyVars   = tyvars'
 1818                           , tcdFixity   = fixity
 1819                           , tcdDataDefn = defn'
 1820                           , tcdDExt     = rn_info }, fvs) } }
 1821 
 1822 rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
 1823                         tcdTyVars = tyvars, tcdFixity = fixity,
 1824                         tcdFDs = fds, tcdSigs = sigs,
 1825                         tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
 1826                         tcdDocs = docs})
 1827   = do  { lcls' <- lookupLocatedTopConstructorRnN lcls
 1828         ; let cls' = unLoc lcls'
 1829               kvs = []  -- No scoped kind vars except those in
 1830                         -- kind signatures on the tyvars
 1831 
 1832         -- Tyvars scope over superclass context and method signatures
 1833         ; ((tyvars', context', fds', ats'), stuff_fvs)
 1834             <- bindHsQTyVars cls_doc Nothing kvs tyvars $ \ tyvars' _ -> do
 1835                   -- Checks for distinct tyvars
 1836              { (context', cxt_fvs) <- rnMaybeContext cls_doc context
 1837              ; fds'  <- rnFds fds
 1838                          -- The fundeps have no free variables
 1839              ; (ats', fv_ats) <- rnATDecls cls' ats
 1840              ; let fvs = cxt_fvs     `plusFV`
 1841                          fv_ats
 1842              ; return ((tyvars', context', fds', ats'), fvs) }
 1843 
 1844         ; (at_defs', fv_at_defs) <- rnList (rnTyFamDefltDecl cls') at_defs
 1845 
 1846         -- No need to check for duplicate associated type decls
 1847         -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn
 1848 
 1849         -- Check the signatures
 1850         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 1851         ; let sig_rdr_names_w_locs =
 1852                 [op | L _ (ClassOpSig _ False ops _) <- sigs
 1853                     , op <- ops]
 1854         ; checkDupRdrNamesN sig_rdr_names_w_locs
 1855                 -- Typechecker is responsible for checking that we only
 1856                 -- give default-method bindings for things in this class.
 1857                 -- The renamer *could* check this for class decls, but can't
 1858                 -- for instance decls.
 1859 
 1860         -- The newLocals call is tiresome: given a generic class decl
 1861         --      class C a where
 1862         --        op :: a -> a
 1863         --        op {| x+y |} (Inl a) = ...
 1864         --        op {| x+y |} (Inr b) = ...
 1865         --        op {| a*b |} (a*b)   = ...
 1866         -- we want to name both "x" tyvars with the same unique, so that they are
 1867         -- easy to group together in the typechecker.
 1868         ; (mbinds', sigs', meth_fvs)
 1869             <- rnMethodBinds True cls' (hsAllLTyVarNames tyvars') mbinds sigs
 1870                 -- No need to check for duplicate method signatures
 1871                 -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn
 1872                 -- and the methods are already in scope
 1873 
 1874         ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs
 1875         ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',
 1876                               tcdTyVars = tyvars', tcdFixity = fixity,
 1877                               tcdFDs = fds', tcdSigs = sigs',
 1878                               tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',
 1879                               tcdDocs = docs, tcdCExt = all_fvs },
 1880                   all_fvs ) }
 1881   where
 1882     cls_doc  = ClassDeclCtx lcls
 1883 
 1884 -- Does the data type declaration include a CUSK?
 1885 data_decl_has_cusk :: LHsQTyVars (GhcPass p) -> NewOrData -> Bool -> Maybe (LHsKind (GhcPass p')) -> RnM Bool
 1886 data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do
 1887   { -- See Note [Unlifted Newtypes and CUSKs], and for a broader
 1888     -- picture, see Note [Implementation of UnliftedNewtypes].
 1889   ; unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
 1890   ; let non_cusk_newtype
 1891           | NewType <- new_or_data =
 1892               unlifted_newtypes && isNothing kind_sig
 1893           | otherwise = False
 1894     -- See Note [CUSKs: complete user-supplied kind signatures] in GHC.Hs.Decls
 1895   ; return $ hsTvbAllKinded tyvars && no_rhs_kvs && not non_cusk_newtype
 1896   }
 1897 
 1898 {- Note [Unlifted Newtypes and CUSKs]
 1899 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1900 When unlifted newtypes are enabled, a newtype must have a kind signature
 1901 in order to be considered have a CUSK. This is because the flow of
 1902 kind inference works differently. Consider:
 1903 
 1904   newtype Foo = FooC Int
 1905 
 1906 When UnliftedNewtypes is disabled, we decide that Foo has kind
 1907 `TYPE 'LiftedRep` without looking inside the data constructor. So, we
 1908 can say that Foo has a CUSK. However, when UnliftedNewtypes is enabled,
 1909 we fill in the kind of Foo as a metavar that gets solved by unification
 1910 with the kind of the field inside FooC (that is, Int, whose kind is
 1911 `TYPE 'LiftedRep`). But since we have to look inside the data constructors
 1912 to figure out the kind signature of Foo, it does not have a CUSK.
 1913 
 1914 See Note [Implementation of UnliftedNewtypes] for where this fits in to
 1915 the broader picture of UnliftedNewtypes.
 1916 -}
 1917 
 1918 -- "type" and "type instance" declarations
 1919 rnTySyn :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
 1920 rnTySyn doc rhs = rnLHsType doc rhs
 1921 
 1922 rnDataDefn :: HsDocContext -> HsDataDefn GhcPs
 1923            -> RnM (HsDataDefn GhcRn, FreeVars)
 1924 rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
 1925                            , dd_ctxt = context, dd_cons = condecls
 1926                            , dd_kindSig = m_sig, dd_derivs = derivs })
 1927   = do  { checkTc (h98_style || null (fromMaybeContext context))
 1928                   (badGadtStupidTheta doc)
 1929 
 1930         ; (m_sig', sig_fvs) <- case m_sig of
 1931              Just sig -> first Just <$> rnLHsKind doc sig
 1932              Nothing  -> return (Nothing, emptyFVs)
 1933         ; (context', fvs1) <- rnMaybeContext doc context
 1934         ; (derivs',  fvs3) <- rn_derivs derivs
 1935 
 1936         -- For the constructor declarations, drop the LocalRdrEnv
 1937         -- in the GADT case, where the type variables in the declaration
 1938         -- do not scope over the constructor signatures
 1939         -- data T a where { T1 :: forall b. b-> b }
 1940         ; let { zap_lcl_env | h98_style = \ thing -> thing
 1941                             | otherwise = setLocalRdrEnv emptyLocalRdrEnv }
 1942         ; (condecls', con_fvs) <- zap_lcl_env $ rnConDecls condecls
 1943            -- No need to check for duplicate constructor decls
 1944            -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn
 1945 
 1946         ; let all_fvs = fvs1 `plusFV` fvs3 `plusFV`
 1947                         con_fvs `plusFV` sig_fvs
 1948         ; return ( HsDataDefn { dd_ext = noExtField
 1949                               , dd_ND = new_or_data, dd_cType = cType
 1950                               , dd_ctxt = context', dd_kindSig = m_sig'
 1951                               , dd_cons = condecls'
 1952                               , dd_derivs = derivs' }
 1953                  , all_fvs )
 1954         }
 1955   where
 1956     h98_style = case condecls of  -- Note [Stupid theta]
 1957                      (L _ (ConDeclGADT {}))                    : _ -> False
 1958                      _                                             -> True
 1959 
 1960     rn_derivs ds
 1961       = do { deriv_strats_ok <- xoptM LangExt.DerivingStrategies
 1962            ; failIfTc (lengthExceeds ds 1 && not deriv_strats_ok)
 1963                multipleDerivClausesErr
 1964            ; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds
 1965            ; return (ds', fvs) }
 1966 
 1967 warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
 1968                  -> SrcSpan
 1969                  -> RnM ()
 1970 warnNoDerivStrat mds loc
 1971   = do { dyn_flags <- getDynFlags
 1972        ; case mds of
 1973            Nothing ->
 1974              let dia = TcRnUnknownMessage $
 1975                    mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingDerivingStrategies) noHints $
 1976                      (if xopt LangExt.DerivingStrategies dyn_flags
 1977                        then no_strat_warning
 1978                        else no_strat_warning $+$ deriv_strat_nenabled
 1979                      )
 1980              in addDiagnosticAt loc dia
 1981            _ -> pure ()
 1982        }
 1983   where
 1984     no_strat_warning :: SDoc
 1985     no_strat_warning = text "No deriving strategy specified. Did you want stock"
 1986                        <> text ", newtype, or anyclass?"
 1987     deriv_strat_nenabled :: SDoc
 1988     deriv_strat_nenabled = text "Use DerivingStrategies to specify a strategy."
 1989 
 1990 rnLHsDerivingClause :: HsDocContext -> LHsDerivingClause GhcPs
 1991                     -> RnM (LHsDerivingClause GhcRn, FreeVars)
 1992 rnLHsDerivingClause doc
 1993                 (L loc (HsDerivingClause
 1994                               { deriv_clause_ext = noExtField
 1995                               , deriv_clause_strategy = dcs
 1996                               , deriv_clause_tys = dct }))
 1997   = do { (dcs', dct', fvs)
 1998            <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct
 1999        ; warnNoDerivStrat dcs' (locA loc)
 2000        ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField
 2001                                         , deriv_clause_strategy = dcs'
 2002                                         , deriv_clause_tys = dct' })
 2003               , fvs ) }
 2004   where
 2005     rn_deriv_clause_tys :: LDerivClauseTys GhcPs
 2006                         -> RnM (LDerivClauseTys GhcRn, FreeVars)
 2007     rn_deriv_clause_tys (L l dct) = case dct of
 2008       DctSingle x ty -> do
 2009         (ty', fvs) <- rn_clause_pred ty
 2010         pure (L l (DctSingle x ty'), fvs)
 2011       DctMulti x tys -> do
 2012         (tys', fvs) <- mapFvRn rn_clause_pred tys
 2013         pure (L l (DctMulti x tys'), fvs)
 2014 
 2015     rn_clause_pred :: LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars)
 2016     rn_clause_pred pred_ty = do
 2017       let inf_err = Just (text "Inferred type variables are not allowed")
 2018       checkInferredVars doc inf_err pred_ty
 2019       ret@(pred_ty', _) <- rnHsSigType doc TypeLevel pred_ty
 2020       -- Check if there are any nested `forall`s, which are illegal in a
 2021       -- `deriving` clause.
 2022       -- See Note [No nested foralls or contexts in instance types]
 2023       -- (Wrinkle: Derived instances) in GHC.Hs.Type.
 2024       addNoNestedForallsContextsErr doc (text "Derived class type")
 2025         (getLHsInstDeclHead pred_ty')
 2026       pure ret
 2027 
 2028 rnLDerivStrategy :: forall a.
 2029                     HsDocContext
 2030                  -> Maybe (LDerivStrategy GhcPs)
 2031                  -> RnM (a, FreeVars)
 2032                  -> RnM (Maybe (LDerivStrategy GhcRn), a, FreeVars)
 2033 rnLDerivStrategy doc mds thing_inside
 2034   = case mds of
 2035       Nothing -> boring_case Nothing
 2036       Just (L loc ds) ->
 2037         setSrcSpanA loc $ do
 2038           (ds', thing, fvs) <- rn_deriv_strat ds
 2039           pure (Just (L loc ds'), thing, fvs)
 2040   where
 2041     rn_deriv_strat :: DerivStrategy GhcPs
 2042                    -> RnM (DerivStrategy GhcRn, a, FreeVars)
 2043     rn_deriv_strat ds = do
 2044       let extNeeded :: LangExt.Extension
 2045           extNeeded
 2046             | ViaStrategy{} <- ds
 2047             = LangExt.DerivingVia
 2048             | otherwise
 2049             = LangExt.DerivingStrategies
 2050 
 2051       unlessXOptM extNeeded $
 2052         failWith $ illegalDerivStrategyErr ds
 2053 
 2054       case ds of
 2055         StockStrategy    _ -> boring_case (StockStrategy noExtField)
 2056         AnyclassStrategy _ -> boring_case (AnyclassStrategy noExtField)
 2057         NewtypeStrategy  _ -> boring_case (NewtypeStrategy noExtField)
 2058         ViaStrategy (XViaStrategyPs _ via_ty) ->
 2059           do checkInferredVars doc inf_err via_ty
 2060              (via_ty', fvs1) <- rnHsSigType doc TypeLevel via_ty
 2061              let HsSig { sig_bndrs = via_outer_bndrs
 2062                        , sig_body  = via_body } = unLoc via_ty'
 2063                  via_tvs = hsOuterTyVarNames via_outer_bndrs
 2064              -- Check if there are any nested `forall`s, which are illegal in a
 2065              -- `via` type.
 2066              -- See Note [No nested foralls or contexts in instance types]
 2067              -- (Wrinkle: Derived instances) in GHC.Hs.Type.
 2068              addNoNestedForallsContextsErr doc
 2069                (quotes (text "via") <+> text "type") via_body
 2070              (thing, fvs2) <- bindLocalNamesFV via_tvs thing_inside
 2071              pure (ViaStrategy via_ty', thing, fvs1 `plusFV` fvs2)
 2072 
 2073     inf_err = Just (text "Inferred type variables are not allowed")
 2074 
 2075     boring_case :: ds -> RnM (ds, a, FreeVars)
 2076     boring_case ds = do
 2077       (thing, fvs) <- thing_inside
 2078       pure (ds, thing, fvs)
 2079 
 2080 badGadtStupidTheta :: HsDocContext -> TcRnMessage
 2081 badGadtStupidTheta _
 2082   = TcRnUnknownMessage $ mkPlainError noHints $
 2083     vcat [text "No context is allowed on a GADT-style data declaration",
 2084           text "(You can put a context on each constructor, though.)"]
 2085 
 2086 illegalDerivStrategyErr :: DerivStrategy GhcPs -> TcRnMessage
 2087 illegalDerivStrategyErr ds
 2088   = TcRnUnknownMessage $ mkPlainError noHints $
 2089     vcat [ text "Illegal deriving strategy" <> colon <+> derivStrategyName ds
 2090          , text enableStrategy ]
 2091 
 2092   where
 2093     enableStrategy :: String
 2094     enableStrategy
 2095       | ViaStrategy{} <- ds
 2096       = "Use DerivingVia to enable this extension"
 2097       | otherwise
 2098       = "Use DerivingStrategies to enable this extension"
 2099 
 2100 multipleDerivClausesErr :: TcRnMessage
 2101 multipleDerivClausesErr
 2102   = TcRnUnknownMessage $ mkPlainError noHints $
 2103     vcat [ text "Illegal use of multiple, consecutive deriving clauses"
 2104          , text "Use DerivingStrategies to allow this" ]
 2105 
 2106 rnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested
 2107                         --             inside an *class decl* for cls
 2108                         --             used for associated types
 2109           -> FamilyDecl GhcPs
 2110           -> RnM (FamilyDecl GhcRn, FreeVars)
 2111 rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
 2112                              , fdTopLevel = toplevel
 2113                              , fdFixity = fixity
 2114                              , fdInfo = info, fdResultSig = res_sig
 2115                              , fdInjectivityAnn = injectivity })
 2116   = do { tycon' <- lookupLocatedTopConstructorRnN tycon
 2117        ; ((tyvars', res_sig', injectivity'), fv1) <-
 2118             bindHsQTyVars doc mb_cls kvs tyvars $ \ tyvars' _ ->
 2119             do { let rn_sig = rnFamResultSig doc
 2120                ; (res_sig', fv_kind) <- wrapLocFstMA rn_sig res_sig
 2121                ; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')
 2122                                           injectivity
 2123                ; return ( (tyvars', res_sig', injectivity') , fv_kind ) }
 2124        ; (info', fv2) <- rn_info info
 2125        ; return (FamilyDecl { fdExt = noAnn
 2126                             , fdLName = tycon', fdTyVars = tyvars'
 2127                             , fdTopLevel = toplevel
 2128                             , fdFixity = fixity
 2129                             , fdInfo = info', fdResultSig = res_sig'
 2130                             , fdInjectivityAnn = injectivity' }
 2131                 , fv1 `plusFV` fv2) }
 2132   where
 2133      doc = TyFamilyCtx tycon
 2134      kvs = extractRdrKindSigVars res_sig
 2135 
 2136      ----------------------
 2137      rn_info :: FamilyInfo GhcPs -> RnM (FamilyInfo GhcRn, FreeVars)
 2138      rn_info (ClosedTypeFamily (Just eqns))
 2139        = do { (eqns', fvs)
 2140                 <- rnList (rnTyFamInstEqn (NonAssocTyFamEqn ClosedTyFam)) eqns
 2141                                           -- no class context
 2142             ; return (ClosedTypeFamily (Just eqns'), fvs) }
 2143      rn_info (ClosedTypeFamily Nothing)
 2144        = return (ClosedTypeFamily Nothing, emptyFVs)
 2145      rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
 2146      rn_info DataFamily     = return (DataFamily, emptyFVs)
 2147 
 2148 rnFamResultSig :: HsDocContext
 2149                -> FamilyResultSig GhcPs
 2150                -> RnM (FamilyResultSig GhcRn, FreeVars)
 2151 rnFamResultSig _ (NoSig _)
 2152    = return (NoSig noExtField, emptyFVs)
 2153 rnFamResultSig doc (KindSig _ kind)
 2154    = do { (rndKind, ftvs) <- rnLHsKind doc kind
 2155         ;  return (KindSig noExtField rndKind, ftvs) }
 2156 rnFamResultSig doc (TyVarSig _ tvbndr)
 2157    = do { -- `TyVarSig` tells us that user named the result of a type family by
 2158           -- writing `= tyvar` or `= (tyvar :: kind)`. In such case we want to
 2159           -- be sure that the supplied result name is not identical to an
 2160           -- already in-scope type variable from an enclosing class.
 2161           --
 2162           --  Example of disallowed declaration:
 2163           --         class C a b where
 2164           --            type F b = a | a -> b
 2165           rdr_env <- getLocalRdrEnv
 2166        ;  let resName = hsLTyVarName tvbndr
 2167        ;  when (resName `elemLocalRdrEnv` rdr_env) $
 2168           addErrAt (getLocA tvbndr) $ TcRnUnknownMessage $ mkPlainError noHints $
 2169                      (hsep [ text "Type variable", quotes (ppr resName) <> comma
 2170                            , text "naming a type family result,"
 2171                            ] $$
 2172                       text "shadows an already bound type variable")
 2173 
 2174        ; bindLHsTyVarBndr doc Nothing -- This might be a lie, but it's used for
 2175                                       -- scoping checks that are irrelevant here
 2176                           tvbndr $ \ tvbndr' ->
 2177          return (TyVarSig noExtField tvbndr', unitFV (hsLTyVarName tvbndr')) }
 2178 
 2179 -- Note [Renaming injectivity annotation]
 2180 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 2181 --
 2182 -- During renaming of injectivity annotation we have to make several checks to
 2183 -- make sure that it is well-formed.  At the moment injectivity annotation
 2184 -- consists of a single injectivity condition, so the terms "injectivity
 2185 -- annotation" and "injectivity condition" might be used interchangeably.  See
 2186 -- Note [Injectivity annotation] for a detailed discussion of currently allowed
 2187 -- injectivity annotations.
 2188 --
 2189 -- Checking LHS is simple because the only type variable allowed on the LHS of
 2190 -- injectivity condition is the variable naming the result in type family head.
 2191 -- Example of disallowed annotation:
 2192 --
 2193 --     type family Foo a b = r | b -> a
 2194 --
 2195 -- Verifying RHS of injectivity consists of checking that:
 2196 --
 2197 --  1. only variables defined in type family head appear on the RHS (kind
 2198 --     variables are also allowed).  Example of disallowed annotation:
 2199 --
 2200 --        type family Foo a = r | r -> b
 2201 --
 2202 --  2. for associated types the result variable does not shadow any of type
 2203 --     class variables. Example of disallowed annotation:
 2204 --
 2205 --        class Foo a b where
 2206 --           type F a = b | b -> a
 2207 --
 2208 -- Breaking any of these assumptions results in an error.
 2209 
 2210 -- | Rename injectivity annotation. Note that injectivity annotation is just the
 2211 -- part after the "|".  Everything that appears before it is renamed in
 2212 -- rnFamDecl.
 2213 rnInjectivityAnn :: LHsQTyVars GhcRn           -- ^ Type variables declared in
 2214                                                --   type family head
 2215                  -> LFamilyResultSig GhcRn     -- ^ Result signature
 2216                  -> LInjectivityAnn GhcPs      -- ^ Injectivity annotation
 2217                  -> RnM (LInjectivityAnn GhcRn)
 2218 rnInjectivityAnn tvBndrs (L _ (TyVarSig _ resTv))
 2219                  (L srcSpan (InjectivityAnn x injFrom injTo))
 2220  = do
 2221    { (injDecl'@(L _ (InjectivityAnn _ injFrom' injTo')), noRnErrors)
 2222           <- askNoErrs $
 2223              bindLocalNames [hsLTyVarName resTv] $
 2224              -- The return type variable scopes over the injectivity annotation
 2225              -- e.g.   type family F a = (r::*) | r -> a
 2226              do { injFrom' <- rnLTyVar injFrom
 2227                 ; injTo'   <- mapM rnLTyVar injTo
 2228                 -- Note: srcSpan is unchanged, but typechecker gets
 2229                 -- confused, l2l call makes it happy
 2230                 ; return $ L (l2l srcSpan) (InjectivityAnn x injFrom' injTo') }
 2231 
 2232    ; let tvNames  = Set.fromList $ hsAllLTyVarNames tvBndrs
 2233          resName  = hsLTyVarName resTv
 2234          -- See Note [Renaming injectivity annotation]
 2235          lhsValid = EQ == (stableNameCmp resName (unLoc injFrom'))
 2236          rhsValid = Set.fromList (map unLoc injTo') `Set.difference` tvNames
 2237 
 2238    -- if renaming of type variables ended with errors (eg. there were
 2239    -- not-in-scope variables) don't check the validity of injectivity
 2240    -- annotation. This gives better error messages.
 2241    ; when (noRnErrors && not lhsValid) $
 2242         addErrAt (getLocA injFrom) $ TcRnUnknownMessage $ mkPlainError noHints $
 2243               ( vcat [ text $ "Incorrect type variable on the LHS of "
 2244                            ++ "injectivity condition"
 2245               , nest 5
 2246               ( vcat [ text "Expected :" <+> ppr resName
 2247                      , text "Actual   :" <+> ppr injFrom ])])
 2248 
 2249    ; when (noRnErrors && not (Set.null rhsValid)) $
 2250       do { let errorVars = Set.toList rhsValid
 2251          ; addErrAt (locA srcSpan) $ TcRnUnknownMessage $ mkPlainError noHints $
 2252                         ( hsep
 2253                         [ text "Unknown type variable" <> plural errorVars
 2254                         , text "on the RHS of injectivity condition:"
 2255                         , interpp'SP errorVars ] ) }
 2256 
 2257    ; return injDecl' }
 2258 
 2259 -- We can only hit this case when the user writes injectivity annotation without
 2260 -- naming the result:
 2261 --
 2262 --   type family F a | result -> a
 2263 --   type family F a :: * | result -> a
 2264 --
 2265 -- So we rename injectivity annotation like we normally would except that
 2266 -- this time we expect "result" to be reported not in scope by rnLTyVar.
 2267 rnInjectivityAnn _ _ (L srcSpan (InjectivityAnn x injFrom injTo)) =
 2268    setSrcSpanA srcSpan $ do
 2269    (injDecl', _) <- askNoErrs $ do
 2270      injFrom' <- rnLTyVar injFrom
 2271      injTo'   <- mapM rnLTyVar injTo
 2272      return $ L srcSpan (InjectivityAnn x injFrom' injTo')
 2273    return $ injDecl'
 2274 
 2275 {-
 2276 Note [Stupid theta]
 2277 ~~~~~~~~~~~~~~~~~~~
 2278 #3850 complains about a regression wrt 6.10 for
 2279      data Show a => T a
 2280 There is no reason not to allow the stupid theta if there are no data
 2281 constructors.  It's still stupid, but does no harm, and I don't want
 2282 to cause programs to break unnecessarily (notably HList).  So if there
 2283 are no data constructors we allow h98_style = True
 2284 -}
 2285 
 2286 
 2287 {- *****************************************************
 2288 *                                                      *
 2289      Support code for type/data declarations
 2290 *                                                      *
 2291 ***************************************************** -}
 2292 
 2293 -----------------
 2294 rnConDecls :: [LConDecl GhcPs] -> RnM ([LConDecl GhcRn], FreeVars)
 2295 rnConDecls = mapFvRn (wrapLocFstMA rnConDecl)
 2296 
 2297 rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)
 2298 rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
 2299                            , con_mb_cxt = mcxt, con_args = args
 2300                            , con_doc = mb_doc, con_forall = forall })
 2301   = do  { _        <- addLocMA checkConName name
 2302         ; new_name <- lookupLocatedTopConstructorRnN name
 2303 
 2304         -- We bind no implicit binders here; this is just like
 2305         -- a nested HsForAllTy.  E.g. consider
 2306         --         data T a = forall (b::k). MkT (...)
 2307         -- The 'k' will already be in scope from the bindHsQTyVars
 2308         -- for the data decl itself. So we'll get
 2309         --         data T {k} a = ...
 2310         -- And indeed we may later discover (a::k).  But that's the
 2311         -- scoping we get.  So no implicit binders at the existential forall
 2312 
 2313         ; let ctxt = ConDeclCtx [new_name]
 2314         ; bindLHsTyVarBndrs ctxt WarnUnusedForalls
 2315                             Nothing ex_tvs $ \ new_ex_tvs ->
 2316     do  { (new_context, fvs1) <- rnMbContext ctxt mcxt
 2317         ; (new_args,    fvs2) <- rnConDeclH98Details (unLoc new_name) ctxt args
 2318         ; let all_fvs  = fvs1 `plusFV` fvs2
 2319         ; traceRn "rnConDecl (ConDeclH98)" (ppr name <+> vcat
 2320              [ text "ex_tvs:" <+> ppr ex_tvs
 2321              , text "new_ex_dqtvs':" <+> ppr new_ex_tvs ])
 2322 
 2323         ; return (decl { con_ext = noAnn
 2324                        , con_name = new_name, con_ex_tvs = new_ex_tvs
 2325                        , con_mb_cxt = new_context, con_args = new_args
 2326                        , con_doc = mb_doc
 2327                        , con_forall = forall }, -- Remove when #18311 is fixed
 2328                   all_fvs) }}
 2329 
 2330 rnConDecl (ConDeclGADT { con_names   = names
 2331                        , con_bndrs   = L l outer_bndrs
 2332                        , con_mb_cxt  = mcxt
 2333                        , con_g_args  = args
 2334                        , con_res_ty  = res_ty
 2335                        , con_doc     = mb_doc })
 2336   = do  { mapM_ (addLocMA checkConName) names
 2337         ; new_names <- mapM (lookupLocatedTopConstructorRnN) names
 2338 
 2339         ; let -- We must ensure that we extract the free tkvs in left-to-right
 2340               -- order of their appearance in the constructor type.
 2341               -- That order governs the order the implicitly-quantified type
 2342               -- variable, and hence the order needed for visible type application
 2343               -- See #14808.
 2344               implicit_bndrs =
 2345                 extractHsOuterTvBndrs outer_bndrs           $
 2346                 extractHsTysRdrTyVars (hsConDeclTheta mcxt) $
 2347                 extractConDeclGADTDetailsTyVars args        $
 2348                 extractHsTysRdrTyVars [res_ty] []
 2349 
 2350         ; let ctxt = ConDeclCtx new_names
 2351 
 2352         ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' ->
 2353     do  { (new_cxt, fvs1)    <- rnMbContext ctxt mcxt
 2354         ; (new_args, fvs2)   <- rnConDeclGADTDetails (unLoc (head new_names)) ctxt args
 2355         ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty
 2356 
 2357          -- Ensure that there are no nested `forall`s or contexts, per
 2358          -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
 2359          -- in GHC.Hs.Type.
 2360        ; addNoNestedForallsContextsErr ctxt
 2361            (text "GADT constructor type signature") new_res_ty
 2362 
 2363         ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3
 2364 
 2365         ; traceRn "rnConDecl (ConDeclGADT)"
 2366             (ppr names $$ ppr outer_bndrs')
 2367         ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names
 2368                               , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt
 2369                               , con_g_args = new_args, con_res_ty = new_res_ty
 2370                               , con_doc = mb_doc },
 2371                   all_fvs) } }
 2372 
 2373 rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
 2374             -> RnM (Maybe (LHsContext GhcRn), FreeVars)
 2375 rnMbContext _    Nothing    = return (Nothing, emptyFVs)
 2376 rnMbContext doc cxt = do { (ctx',fvs) <- rnMaybeContext doc cxt
 2377                          ; return (ctx',fvs) }
 2378 
 2379 rnConDeclH98Details ::
 2380       Name
 2381    -> HsDocContext
 2382    -> HsConDeclH98Details GhcPs
 2383    -> RnM (HsConDeclH98Details GhcRn, FreeVars)
 2384 rnConDeclH98Details _ doc (PrefixCon _ tys)
 2385   = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
 2386        ; return (PrefixCon noTypeArgs new_tys, fvs) }
 2387 rnConDeclH98Details _ doc (InfixCon ty1 ty2)
 2388   = do { (new_ty1, fvs1) <- rnScaledLHsType doc ty1
 2389        ; (new_ty2, fvs2) <- rnScaledLHsType doc ty2
 2390        ; return (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2) }
 2391 rnConDeclH98Details con doc (RecCon flds)
 2392   = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
 2393        ; return (RecCon new_flds, fvs) }
 2394 
 2395 rnConDeclGADTDetails ::
 2396       Name
 2397    -> HsDocContext
 2398    -> HsConDeclGADTDetails GhcPs
 2399    -> RnM (HsConDeclGADTDetails GhcRn, FreeVars)
 2400 rnConDeclGADTDetails _ doc (PrefixConGADT tys)
 2401   = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
 2402        ; return (PrefixConGADT new_tys, fvs) }
 2403 rnConDeclGADTDetails con doc (RecConGADT flds arr)
 2404   = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
 2405        ; return (RecConGADT new_flds arr, fvs) }
 2406 
 2407 rnRecConDeclFields ::
 2408      Name
 2409   -> HsDocContext
 2410   -> LocatedL [LConDeclField GhcPs]
 2411   -> RnM (LocatedL [LConDeclField GhcRn], FreeVars)
 2412 rnRecConDeclFields con doc (L l fields)
 2413   = do  { fls <- lookupConstructorFields con
 2414         ; (new_fields, fvs) <- rnConDeclFields doc fls fields
 2415                 -- No need to check for duplicate fields
 2416                 -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn
 2417         ; pure (L l new_fields, fvs) }
 2418 
 2419 -------------------------------------------------
 2420 
 2421 -- | Brings pattern synonym names and also pattern synonym selectors
 2422 -- from record pattern synonyms into scope.
 2423 extendPatSynEnv :: DuplicateRecordFields -> FieldSelectors -> HsValBinds GhcPs -> MiniFixityEnv
 2424                 -> ([Name] -> TcRnIf TcGblEnv TcLclEnv a) -> TcM a
 2425 extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
 2426      names_with_fls <- new_ps val_decls
 2427    ; let pat_syn_bndrs = concat [ name: map flSelector fields
 2428                                 | (name, fields) <- names_with_fls ]
 2429    ; let avails = map avail (map fst names_with_fls)
 2430                ++ map availField (concatMap snd names_with_fls)
 2431    ; (gbl_env, lcl_env) <- extendGlobalRdrEnvRn avails local_fix_env
 2432 
 2433    ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls
 2434          final_gbl_env = gbl_env { tcg_field_env = field_env' }
 2435    ; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
 2436   where
 2437     new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])]
 2438     new_ps (ValBinds _ binds _) = foldrM new_ps' [] binds
 2439     new_ps _ = panic "new_ps"
 2440 
 2441     new_ps' :: LHsBindLR GhcPs GhcPs
 2442             -> [(Name, [FieldLabel])]
 2443             -> TcM [(Name, [FieldLabel])]
 2444     new_ps' bind names
 2445       | (L bind_loc (PatSynBind _ (PSB { psb_id = L _ n
 2446                                        , psb_args = RecCon as }))) <- bind
 2447       = do
 2448           bnd_name <- newTopSrcBinder (L (l2l bind_loc) n)
 2449           let field_occs = map ((\ f -> L (noAnnSrcSpan $ getLocA (foLabel f)) f) . recordPatSynField) as
 2450           flds <- mapM (newRecordSelector dup_fields_ok has_sel [bnd_name]) field_occs
 2451           return ((bnd_name, flds): names)
 2452       | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n})) <- bind
 2453       = do
 2454         bnd_name <- newTopSrcBinder (L (la2na bind_loc) n)
 2455         return ((bnd_name, []): names)
 2456       | otherwise
 2457       = return names
 2458 
 2459 {-
 2460 *********************************************************
 2461 *                                                      *
 2462 \subsection{Support code to rename types}
 2463 *                                                      *
 2464 *********************************************************
 2465 -}
 2466 
 2467 rnFds :: [LHsFunDep GhcPs] -> RnM [LHsFunDep GhcRn]
 2468 rnFds fds
 2469   = mapM (wrapLocMA rn_fds) fds
 2470   where
 2471     rn_fds :: FunDep GhcPs -> RnM (FunDep GhcRn)
 2472     rn_fds (FunDep x tys1 tys2)
 2473       = do { tys1' <- rnHsTyVars tys1
 2474            ; tys2' <- rnHsTyVars tys2
 2475            ; return (FunDep x tys1' tys2') }
 2476 
 2477 rnHsTyVars :: [LocatedN RdrName] -> RnM [LocatedN Name]
 2478 rnHsTyVars tvs  = mapM rnHsTyVar tvs
 2479 
 2480 rnHsTyVar :: LocatedN RdrName -> RnM (LocatedN Name)
 2481 rnHsTyVar (L l tyvar) = do
 2482   tyvar' <- lookupOccRn tyvar
 2483   return (L l tyvar')
 2484 
 2485 {-
 2486 *********************************************************
 2487 *                                                      *
 2488         findSplice
 2489 *                                                      *
 2490 *********************************************************
 2491 
 2492 This code marches down the declarations, looking for the first
 2493 Template Haskell splice.  As it does so it
 2494         a) groups the declarations into a HsGroup
 2495         b) runs any top-level quasi-quotes
 2496 -}
 2497 
 2498 findSplice :: [LHsDecl GhcPs]
 2499            -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
 2500 findSplice ds = addl emptyRdrGroup ds
 2501 
 2502 addl :: HsGroup GhcPs -> [LHsDecl GhcPs]
 2503      -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
 2504 -- This stuff reverses the declarations (again) but it doesn't matter
 2505 addl gp []           = return (gp, Nothing)
 2506 addl gp (L l d : ds) = add gp l d ds
 2507 
 2508 
 2509 add :: HsGroup GhcPs -> SrcSpanAnnA -> HsDecl GhcPs -> [LHsDecl GhcPs]
 2510     -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
 2511 
 2512 -- #10047: Declaration QuasiQuoters are expanded immediately, without
 2513 --         causing a group split
 2514 add gp _ (SpliceD _ (SpliceDecl _ (L _ qq@HsQuasiQuote{}) _)) ds
 2515   = do { (ds', _) <- rnTopSpliceDecls qq
 2516        ; addl gp (ds' ++ ds)
 2517        }
 2518 
 2519 add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds
 2520   = do { -- We've found a top-level splice.  If it is an *implicit* one
 2521          -- (i.e. a naked top level expression)
 2522          case flag of
 2523            ExplicitSplice -> return ()
 2524            ImplicitSplice -> do { th_on <- xoptM LangExt.TemplateHaskell
 2525                                 ; unless th_on $ setSrcSpan (locA loc) $
 2526                                   failWith badImplicitSplice }
 2527 
 2528        ; return (gp, Just (splice, ds)) }
 2529   where
 2530     badImplicitSplice :: TcRnMessage
 2531     badImplicitSplice = TcRnUnknownMessage $ mkPlainError noHints $
 2532                         text "Parse error: module header, import declaration"
 2533                      $$ text "or top-level declaration expected."
 2534                      -- The compiler should suggest the above, and not using
 2535                      -- TemplateHaskell since the former suggestion is more
 2536                      -- relevant to the larger base of users.
 2537                      -- See #12146 for discussion.
 2538 
 2539 -- Class declarations: added to the TyClGroup
 2540 add gp@(HsGroup {hs_tyclds = ts}) l (TyClD _ d) ds
 2541   = addl (gp { hs_tyclds = add_tycld (L l d) ts }) ds
 2542 
 2543 -- Signatures: fixity sigs go a different place than all others
 2544 add gp@(HsGroup {hs_fixds = ts}) l (SigD _ (FixSig _ f)) ds
 2545   = addl (gp {hs_fixds = L l f : ts}) ds
 2546 
 2547 -- Standalone kind signatures: added to the TyClGroup
 2548 add gp@(HsGroup {hs_tyclds = ts}) l (KindSigD _ s) ds
 2549   = addl (gp {hs_tyclds = add_kisig (L l s) ts}) ds
 2550 
 2551 add gp@(HsGroup {hs_valds = ts}) l (SigD _ d) ds
 2552   = addl (gp {hs_valds = add_sig (L l d) ts}) ds
 2553 
 2554 -- Value declarations: use add_bind
 2555 add gp@(HsGroup {hs_valds  = ts}) l (ValD _ d) ds
 2556   = addl (gp { hs_valds = add_bind (L l d) ts }) ds
 2557 
 2558 -- Role annotations: added to the TyClGroup
 2559 add gp@(HsGroup {hs_tyclds = ts}) l (RoleAnnotD _ d) ds
 2560   = addl (gp { hs_tyclds = add_role_annot (L l d) ts }) ds
 2561 
 2562 -- NB instance declarations go into TyClGroups. We throw them into the first
 2563 -- group, just as we do for the TyClD case. The renamer will go on to group
 2564 -- and order them later.
 2565 add gp@(HsGroup {hs_tyclds = ts})  l (InstD _ d) ds
 2566   = addl (gp { hs_tyclds = add_instd (L l d) ts }) ds
 2567 
 2568 -- The rest are routine
 2569 add gp@(HsGroup {hs_derivds = ts})  l (DerivD _ d) ds
 2570   = addl (gp { hs_derivds = L l d : ts }) ds
 2571 add gp@(HsGroup {hs_defds  = ts})  l (DefD _ d) ds
 2572   = addl (gp { hs_defds = L l d : ts }) ds
 2573 add gp@(HsGroup {hs_fords  = ts}) l (ForD _ d) ds
 2574   = addl (gp { hs_fords = L l d : ts }) ds
 2575 add gp@(HsGroup {hs_warnds  = ts})  l (WarningD _ d) ds
 2576   = addl (gp { hs_warnds = L l d : ts }) ds
 2577 add gp@(HsGroup {hs_annds  = ts}) l (AnnD _ d) ds
 2578   = addl (gp { hs_annds = L l d : ts }) ds
 2579 add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD _ d) ds
 2580   = addl (gp { hs_ruleds = L l d : ts }) ds
 2581 add gp l (DocD _ d) ds
 2582   = addl (gp { hs_docs = (L l d) : (hs_docs gp) })  ds
 2583 
 2584 add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
 2585           -> [TyClGroup (GhcPass p)]
 2586 add_tycld d []       = [TyClGroup { group_ext    = noExtField
 2587                                   , group_tyclds = [d]
 2588                                   , group_kisigs = []
 2589                                   , group_roles  = []
 2590                                   , group_instds = []
 2591                                   }
 2592                        ]
 2593 add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss)
 2594   = ds { group_tyclds = d : tyclds } : dss
 2595 
 2596 add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
 2597           -> [TyClGroup (GhcPass p)]
 2598 add_instd d []       = [TyClGroup { group_ext    = noExtField
 2599                                   , group_tyclds = []
 2600                                   , group_kisigs = []
 2601                                   , group_roles  = []
 2602                                   , group_instds = [d]
 2603                                   }
 2604                        ]
 2605 add_instd d (ds@(TyClGroup { group_instds = instds }):dss)
 2606   = ds { group_instds = d : instds } : dss
 2607 
 2608 add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
 2609                -> [TyClGroup (GhcPass p)]
 2610 add_role_annot d [] = [TyClGroup { group_ext    = noExtField
 2611                                  , group_tyclds = []
 2612                                  , group_kisigs = []
 2613                                  , group_roles  = [d]
 2614                                  , group_instds = []
 2615                                  }
 2616                       ]
 2617 add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)
 2618   = tycls { group_roles = d : roles } : rest
 2619 
 2620 add_kisig :: LStandaloneKindSig (GhcPass p)
 2621          -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)]
 2622 add_kisig d [] = [TyClGroup { group_ext    = noExtField
 2623                             , group_tyclds = []
 2624                             , group_kisigs = [d]
 2625                             , group_roles  = []
 2626                             , group_instds = []
 2627                             }
 2628                  ]
 2629 add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest)
 2630   = tycls { group_kisigs = d : kisigs } : rest
 2631 
 2632 add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
 2633 add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs
 2634 add_bind _ (XValBindsLR {})     = panic "GHC.Rename.Module.add_bind"
 2635 
 2636 add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
 2637 add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs)
 2638 add_sig _ (XValBindsLR {})     = panic "GHC.Rename.Module.add_sig"