Compare revisions

Simon Peyton Jones · BinderDavid · Marge Bot · Ryan Scott · Marge Bot · Ryan Scott
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -718,6 +718,12 @@ hackage-lint:
    - job: nightly-x86_64-linux-deb10-numa-slow-validate
      optional: true
      artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
+    - job: aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
  extends: .hackage
  variables:
    SLOW_VALIDATE: 1
@@ -733,6 +739,9 @@ hackage-label-lint:
    - job: x86_64-linux-deb10-numa-slow-validate
      optional: true
      artifacts: false
+    - job: aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
  extends: .hackage
  variables:
    SLOW_VALIDATE: 1
@@ -747,6 +756,9 @@ nightly-hackage-lint:
    - job: nightly-x86_64-linux-deb10-numa-slow-validate
      optional: true
      artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
  rules:
    - if: $NIGHTLY
      variables:
@@ -761,6 +773,9 @@ nightly-hackage-perf:
    - job: nightly-x86_64-linux-fedora33-release
      optional: true
      artifacts: false
+    - job: nightly-aarch64-linux-deb10-validate
+      optional: true
+      artifacts: false
  rules:
    - if: $NIGHTLY
      variables:
@@ -777,6 +792,9 @@ release-hackage-lint:
    - job: release-x86_64-linux-fedora33-release
      optional: true
      artifacts: false
+    - job: release-aarch64-linux-deb10-release+no_split_sections
+      optional: true
+      artifacts: false
  rules:
    - if: '$RELEASE_JOB == "yes"'
  extends: .hackage

--- a/HACKING.md
+++ b/HACKING.md
@@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry
 ======================================

 Make sure your system has the necessary tools to compile GHC. You can
-find an overview here:
+find an overview of how to prepare your system for compiling GHC here:

 <https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation>

-Next, clone the repository and all the associated libraries:
+After you have prepared your system, you can build GHC following the instructions described here:

-```
-$ git clone --recursive git@gitlab.haskell.org:ghc/ghc.git
-```
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian>

-On Windows, you need an extra repository containing some build tools.
-These can be downloaded for you by `configure`. This only needs to be done once by running:
-
-```
-$ ./configure --enable-tarballs-autodownload
-```
-
-First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has
-your preferred build settings. (You probably want to at least set
-`BuildFlavour` to `quick`):
-
-```
-$ cp mk/build.mk.sample mk/build.mk
-$ ... double-check mk/build.mk ...
-```
-
-Now build. The convenient `validate` script will build the tree in a way which
-is both quick to build and consistent with our testsuite:
-
-```
-$ ./validate --build-only
-```
-
-You can use the `_validatebuild/stage1/bin/ghc` binary to play with the
-newly built compiler.
-
-Now, hack on your copy and rebuild (with `make`) as necessary.
-
-Then start by making your commits however you want. When you're done, you can submit
-a pull request on Github for small changes. For larger changes the patch needs to be
-submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
+Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
 Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues).
 The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes).


--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -111,6 +111,7 @@ module GHC.Core.Type (
        isTyVarTy, isFunTy, isCoercionTy,
        isCoercionTy_maybe, isForAllTy,
        isForAllTy_ty, isForAllTy_co,
+        isForAllTy_invis_ty,
        isPiTy, isTauTy, isFamFreeTy,
        isCoVarType, isAtomicTy,

@@ -1891,6 +1892,15 @@ isForAllTy_ty ty

  | otherwise = False

+-- | Like `isForAllTy`, but returns True only if it is an inferred tyvar binder
+isForAllTy_invis_ty :: Type -> Bool
+isForAllTy_invis_ty  ty
+  | ForAllTy (Bndr tv (Invisible InferredSpec)) _ <- coreFullView ty
+  , isTyVar tv
+  = True
+
+  | otherwise = False
+
 -- | Like `isForAllTy`, but returns True only if it is a covar binder
 isForAllTy_co :: Type -> Bool
 isForAllTy_co ty

--- a/compiler/GHC/Data/BooleanFormula.hs
+++ b/compiler/GHC/Data/BooleanFormula.hs
@@ -24,8 +24,7 @@ import Data.Data

 import GHC.Utils.Monad
 import GHC.Utils.Outputable
-import GHC.Utils.Binary
-import GHC.Parser.Annotation ( LocatedL, noLocA )
+import GHC.Parser.Annotation ( LocatedL )
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
@@ -243,22 +242,3 @@ pprBooleanFormulaNormal = go
    go (Or [])    = keyword $ text "FALSE"
    go (Or xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)
    go (Parens x) = parens (go $ unLoc x)
-
-
----------------------------------------------------------------------
-- Binary
----------------------------------------------------------------------
-
-instance Binary a => Binary (BooleanFormula a) where
-  put_ bh (Var x)    = putByte bh 0 >> put_ bh x
-  put_ bh (And xs)   = putByte bh 1 >> put_ bh (unLoc <$> xs)
-  put_ bh (Or  xs)   = putByte bh 2 >> put_ bh (unLoc <$> xs)
-  put_ bh (Parens x) = putByte bh 3 >> put_ bh (unLoc x)
-
-  get bh = do
-    h <- getByte bh
-    case h of
-      0 -> Var                  <$> get bh
-      1 -> And    . fmap noLocA <$> get bh
-      2 -> Or     . fmap noLocA <$> get bh
-      _ -> Parens . noLocA      <$> get bh
--- a/compiler/GHC/Driver/Config/Core/Lint.hs
+++ b/compiler/GHC/Driver/Config/Core/Lint.hs
@@ -87,7 +87,7 @@ coreDumpFlag (CoreDoDemand {})        = Just Opt_D_dump_stranal
 coreDumpFlag CoreDoCpr                = Just Opt_D_dump_cpranal
 coreDumpFlag CoreDoWorkerWrapper      = Just Opt_D_dump_worker_wrapper
 coreDumpFlag CoreDoSpecialising       = Just Opt_D_dump_spec
-coreDumpFlag CoreDoSpecConstr         = Just Opt_D_dump_spec
+coreDumpFlag CoreDoSpecConstr         = Just Opt_D_dump_spec_constr
 coreDumpFlag CoreCSE                  = Just Opt_D_dump_cse
 coreDumpFlag CoreDesugar              = Just Opt_D_dump_ds_preopt
 coreDumpFlag CoreDesugarOpt           = Just Opt_D_dump_ds

--- a/compiler/GHC/Driver/Errors.hs
+++ b/compiler/GHC/Driver/Errors.hs
@@ -17,11 +17,12 @@ printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOp
 printMessages logger msg_opts opts msgs
  = sequence_ [ let style = mkErrStyle name_ppr_ctx
                    ctx   = (diag_ppr_ctx opts) { sdocStyle = style }
-                in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $
+                in logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
                   updSDocContext (\_ -> ctx) (messageWithHints dia)
              | MsgEnvelope { errMsgSpan       = s,
                              errMsgDiagnostic = dia,
                              errMsgSeverity   = sev,
+                              errMsgReason     = reason,
                              errMsgContext    = name_ppr_ctx }
                  <- sortMsgBag (Just opts) (getMessages msgs) ]
  where

--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -107,6 +107,7 @@ data DumpFlag
   | Opt_D_dump_simpl
   | Opt_D_dump_simpl_iterations
   | Opt_D_dump_spec
+   | Opt_D_dump_spec_constr
   | Opt_D_dump_prep
   | Opt_D_dump_late_cc
   | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output)
@@ -630,6 +631,7 @@ data WarningFlag =
   | Opt_WarnAmbiguousFields                         -- Since 9.2
   | Opt_WarnImplicitLift                            -- Since 9.2
   | Opt_WarnMissingKindSignatures                   -- Since 9.2
+   | Opt_WarnMissingPolyKindSignatures               -- Since 9.8
   | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2
   | Opt_WarnRedundantStrictnessFlags                -- Since 9.4
   | Opt_WarnForallIdentifier                        -- Since 9.4
@@ -684,6 +686,7 @@ warnFlagNames wflag = case wflag of
  Opt_WarnSemigroup                               -> "semigroup" :| []
  Opt_WarnMissingSignatures                       -> "missing-signatures" :| []
  Opt_WarnMissingKindSignatures                   -> "missing-kind-signatures" :| []
+  Opt_WarnMissingPolyKindSignatures               -> "missing-poly-kind-signatures" :| []
  Opt_WarnMissingExportedSignatures               -> "missing-exported-signatures" :| []
  Opt_WarnMonomorphism                            -> "monomorphism-restriction" :| []
  Opt_WarnNameShadowing                           -> "name-shadowing" :| []

--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -782,16 +782,14 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
    worker_limit <- liftIO $ mkWorkerLimit dflags

    setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
-    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do
+    (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do
      hsc_env <- getSession
      liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan
-    setSession hsc_env1
+    modifySession (addDepsToHscEnv new_deps)
    case upsweep_ok of
      Failed -> loadFinish upsweep_ok
      Succeeded -> do
          liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.")
-          -- Clean up after ourselves
-          liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags
          loadFinish upsweep_ok


@@ -1262,14 +1260,13 @@ upsweep
    -> Maybe Messager
    -> M.Map ModNodeKeyWithUid HomeModInfo
    -> [BuildPlan]
-    -> IO (SuccessFlag, HscEnv)
+    -> IO (SuccessFlag, [HomeModInfo])
 upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do
    (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan
    runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines
    res <- collect_result

    let completed = [m | Just (Just m) <- res]
-    let hsc_env' = addDepsToHscEnv completed hsc_env

    -- Handle any cycle in the original compilation graph and return the result
    -- of the upsweep.
@@ -1277,10 +1274,10 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d
        Just mss -> do
          let logger = hsc_logger hsc_env
          liftIO $ fatalErrorMsg logger (cyclicModuleErr mss)
-          return (Failed, hsc_env)
+          return (Failed, [])
        Nothing  -> do
          let success_flag = successIf (all isJust res)
-          return (success_flag, hsc_env')
+          return (success_flag, completed)

 toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo
 toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis])
@@ -2345,18 +2342,21 @@ withDeferredDiagnostics f = do
          let action = logMsg logger msgClass srcSpan msg
          case msgClass of
            MCDiagnostic SevWarning _reason _code
-              -> atomicModifyIORef' warnings $ \i -> (action: i, ())
+              -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ())
            MCDiagnostic SevError _reason _code
-              -> atomicModifyIORef' errors   $ \i -> (action: i, ())
+              -> atomicModifyIORef' errors   $ \(!i) -> (action: i, ())
            MCFatal
-              -> atomicModifyIORef' fatals   $ \i -> (action: i, ())
+              -> atomicModifyIORef' fatals   $ \(!i) -> (action: i, ())
            _ -> action

        printDeferredDiagnostics = liftIO $
          forM_ [warnings, errors, fatals] $ \ref -> do
            -- This IORef can leak when the dflags leaks, so let us always
-            -- reset the content.
-            actions <- atomicModifyIORef' ref $ \i -> ([], i)
+            -- reset the content. The lazy variant is used here as we want to force
+            -- this error if the IORef is ever accessed again, rather than now.
+            -- See #20981 for an issue which discusses this general issue.
+            let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else []
+            actions <- atomicModifyIORef ref $ \i -> (landmine, i)
            sequence_ $ reverse actions

    MC.bracket
@@ -2432,8 +2432,9 @@ cyclicModuleErr mss

 cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
 cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =
-  unless (gopt Opt_KeepTmpFiles dflags) $
-    liftIO $ cleanCurrentModuleTempFiles logger tmpfs
+  if gopt Opt_KeepTmpFiles dflags
+    then liftIO $ keepCurrentModuleTempFiles logger tmpfs
+    else liftIO $ cleanCurrentModuleTempFiles logger tmpfs


 addDepsToHscEnv ::  [HomeModInfo] -> HscEnv -> HscEnv

--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -292,11 +292,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do

        -- LLVM from version 3.0 onwards doesn't support the OS X system
        -- assembler, so we use clang as the assembler instead. (#5636)
-        let (as_prog, get_asm_info) =
-                ( applyAssemblerProg $ backendAssemblerProg (backend dflags)
-                , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags)
-                )
-        asmInfo <- get_asm_info logger dflags platform
+        let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags)

        let cmdline_include_paths = includePaths dflags
        let pic_c_flags = picCCOpts dflags
@@ -330,9 +326,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
                       ++ [ GHC.SysTools.Option "-Wa,--no-type-check"
                          | platformArch (targetPlatform dflags) == ArchWasm32]

-                       ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51]
-                            then [GHC.SysTools.Option "-Qunused-arguments"]
-                            else [])
                       ++ [ GHC.SysTools.Option "-x"
                          , if with_cpp
                              then GHC.SysTools.Option "assembler-with-cpp"
@@ -400,19 +393,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do
  return output_fn


-applyAssemblerInfoGetter
-    :: DefunctionalizedAssemblerInfoGetter
-    -> Logger -> DynFlags -> Platform -> IO CompilerInfo
-applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform =
-    getAssemblerInfo logger dflags
-applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ =
-    pure Emscripten
-applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform =
-    if platformOS platform == OSDarwin then
-        pure Clang
-    else
-        getAssemblerInfo logger dflags
-
 applyAssemblerProg
    :: DefunctionalizedAssemblerProg
    -> Logger -> DynFlags -> Platform -> [Option] -> IO ()

--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1425,6 +1425,8 @@ dynamic_flags_deps = [
      (setDumpFlag Opt_D_dump_simpl_iterations)
  , make_ord_flag defGhcFlag "ddump-spec"
        (setDumpFlag Opt_D_dump_spec)
+  , make_ord_flag defGhcFlag "ddump-spec-constr"
+        (setDumpFlag Opt_D_dump_spec_constr)
  , make_ord_flag defGhcFlag "ddump-prep"
        (setDumpFlag Opt_D_dump_prep)
  , make_ord_flag defGhcFlag "ddump-late-cc"
@@ -2190,6 +2192,7 @@ wWarningFlagsDeps = mconcat [
  warnSpec    Opt_WarnSemigroup,
  warnSpec    Opt_WarnMissingSignatures,
  warnSpec    Opt_WarnMissingKindSignatures,
+  warnSpec    Opt_WarnMissingPolyKindSignatures,
  subWarnSpec "missing-exported-sigs"
              Opt_WarnMissingExportedSignatures
              "it is replaced by -Wmissing-exported-signatures",

--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -73,7 +73,7 @@ module GHC.Hs.Type (
        mkHsForAllVisTele, mkHsForAllInvisTele,
        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,
        isHsKindedTyVar, hsTvbAllKinded,
-        hsScopedTvs, hsWcScopedTvs, dropWildCards,
+        hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards,
        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,
        splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
@@ -431,6 +431,13 @@ hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs}))
  = hsLTyVarNames (hsOuterExplicitBndrs outer_bndrs)
    -- See Note [hsScopedTvs and visible foralls]

+hsScopedKvs :: LHsKind GhcRn -> [Name]
+-- Same as hsScopedTvs, but for a LHsKind
+hsScopedKvs  (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }})
+  = hsLTyVarNames bndrs
+    -- See Note [hsScopedTvs and visible foralls]
+hsScopedKvs _ = []
+
 ---------------------
 hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
 hsTyVarName (UserTyVar _ _ (L _ n))     = n

--- a/compiler/GHC/Iface/Decl.hs
+++ b/compiler/GHC/Iface/Decl.hs

 {-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE LambdaCase #-}

 {-
 (c) The University of Glasgow 2006-2008
@@ -12,6 +13,7 @@
 module GHC.Iface.Decl
   ( coAxiomToIfaceDecl
   , tyThingToIfaceDecl -- Converting things to their Iface equivalents
+   , toIfaceBooleanFormula
   )
 where

@@ -38,12 +40,14 @@ import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Types.TyThing
+import GHC.Types.SrcLoc

 import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc

 import GHC.Data.FastString
 import GHC.Data.Maybe
+import GHC.Data.BooleanFormula

 import Data.List ( findIndex, mapAccumL )

@@ -284,7 +288,7 @@ classToIfaceDecl env clas
                ifClassCtxt   = tidyToIfaceContext env1 sc_theta,
                ifATs    = map toIfaceAT clas_ats,
                ifSigs   = map toIfaceClassOp op_stuff,
-                ifMinDef = fmap getOccFS (classMinimalDef clas)
+                ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas)
            }

    (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
@@ -332,3 +336,10 @@ tidyTyConBinders = mapAccumL tidyTyConBinder

 tidyTyVar :: TidyEnv -> TyVar -> FastString
 tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
+
+toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula
+toIfaceBooleanFormula = \case
+    Var nm    -> IfVar    nm
+    And bfs   -> IfAnd    (map (toIfaceBooleanFormula . unLoc) bfs)
+    Or bfs    -> IfOr     (map (toIfaceBooleanFormula . unLoc) bfs)
+    Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf)
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -17,7 +17,7 @@ module GHC.Iface.Syntax (
        IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..),
        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
-        IfaceClassBody(..),
+        IfaceClassBody(..), IfaceBooleanFormula(..),
        IfaceBang(..),
        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
        IfaceAxBranch(..),
@@ -32,6 +32,7 @@ module GHC.Iface.Syntax (
        -- Misc
        ifaceDeclImplicitBndrs, visibleIfConDecls,
        ifaceDeclFingerprints,
+        fromIfaceBooleanFormula,

        -- Free Names
        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
@@ -66,12 +67,13 @@ import GHC.Types.Annotations( AnnPayload, AnnTarget )
 import GHC.Types.Basic
 import GHC.Unit.Module
 import GHC.Types.SrcLoc
-import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
+import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue )
 import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike )
 import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
 import GHC.Builtin.Types ( constraintKindTyConName )
 import GHC.Stg.InferTags.TagSig
+import GHC.Parser.Annotation (noLocA)

 import GHC.Utils.Lexeme (isLexSym)
 import GHC.Utils.Fingerprint
@@ -191,9 +193,22 @@ data IfaceClassBody
     ifClassCtxt :: IfaceContext,             -- Super classes
     ifATs       :: [IfaceAT],                -- Associated type families
     ifSigs      :: [IfaceClassOp],           -- Method signatures
-     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition
+     ifMinDef    :: IfaceBooleanFormula       -- Minimal complete definition
    }

+data IfaceBooleanFormula
+  = IfVar IfLclName
+  | IfAnd [IfaceBooleanFormula]
+  | IfOr [IfaceBooleanFormula]
+  | IfParens IfaceBooleanFormula
+
+fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName
+fromIfaceBooleanFormula = \case
+    IfVar nm     -> Var    nm
+    IfAnd ibfs   -> And    (map (noLocA . fromIfaceBooleanFormula) ibfs)
+    IfOr ibfs    -> Or     (map (noLocA . fromIfaceBooleanFormula) ibfs)
+    IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf)
+
 data IfaceTyConParent
  = IfNoParent
  | IfDataInstance
@@ -930,7 +945,7 @@ pprIfaceDecl ss (IfaceClass { ifName  = clas
         , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
         , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where
         , nest 2 (vcat [ vcat asocs, vcat dsigs
-                        , ppShowAllSubs ss (pprMinDef minDef)])]
+                        , ppShowAllSubs ss (pprMinDef $ fromIfaceBooleanFormula minDef)])]
    where
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")

@@ -2038,6 +2053,20 @@ instance Binary IfaceDecl where
                        ifBody = IfAbstractClass })
            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])

+instance Binary IfaceBooleanFormula where
+    put_ bh = \case
+        IfVar a1    -> putByte bh 0 >> put_ bh a1
+        IfAnd a1    -> putByte bh 1 >> put_ bh a1
+        IfOr a1     -> putByte bh 2 >> put_ bh a1
+        IfParens a1 -> putByte bh 3 >> put_ bh a1
+
+    get bh = do
+        getByte bh >>= \case
+            0 -> IfVar    <$> get bh
+            1 -> IfAnd    <$> get bh
+            2 -> IfOr     <$> get bh
+            _ -> IfParens <$> get bh
+
 {- Note [Lazy deserialization of IfaceId]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The use of lazyPut and lazyGet in the IfaceId Binary instance is
@@ -2650,7 +2679,14 @@ instance NFData IfaceAxBranch where
 instance NFData IfaceClassBody where
  rnf = \case
    IfAbstractClass -> ()
-    IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()
+    IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` ()
+
+instance NFData IfaceBooleanFormula where
+  rnf = \case
+      IfVar f1    -> rnf f1
+      IfAnd f1    -> rnf f1
+      IfOr f1     -> rnf f1
+      IfParens f1 -> rnf f1

 instance NFData IfaceAT where
  rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2

--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -44,6 +44,7 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig )
 import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
 import GHC.Builtin.Types

+import GHC.Iface.Decl (toIfaceBooleanFormula)
 import GHC.Iface.Syntax
 import GHC.Iface.Load
 import GHC.Iface.Env
@@ -290,7 +291,7 @@ mergeIfaceDecl d1 d2
                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
      in d1 { ifBody = (ifBody d1) {
                ifSigs  = ops,
-                ifMinDef = BF.mkOr [noLocA bf1, noLocA bf2]
+                ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2]
                }
            } `withRolesFrom` d2
    -- It doesn't matter; we'll check for consistency later when
@@ -773,7 +774,7 @@ tc_iface_decl _parent ignore_prags
                         ifBody = IfConcreteClass {
                             ifClassCtxt = rdr_ctxt,
                             ifATs = rdr_ats, ifSigs = rdr_sigs,
-                             ifMinDef = mindef_occ
+                             ifMinDef = if_mindef
                         }})
  = bindIfaceTyConBinders binders $ \ binders' -> do
    { traceIf (text "tc-iface-class1" <+> ppr tc_name)
@@ -782,6 +783,7 @@ tc_iface_decl _parent ignore_prags
    ; sigs <- mapM tc_sig rdr_sigs
    ; fds  <- mapM tc_fd rdr_fds
    ; traceIf (text "tc-iface-class3" <+> ppr tc_name)
+    ; let mindef_occ = fromIfaceBooleanFormula if_mindef
    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
    ; cls  <- fixM $ \ cls -> do
              { ats  <- mapM (tc_at cls) rdr_ats

--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc
                 -> RnM (a, FreeVars)
 rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
  = do { let implicit_vs = nubN implicit_vs_with_dups
-       ; mapM_ warn_term_var_capture implicit_vs

       ; traceRn "rnImplicitTvOccs" $
         vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ]
@@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
         -- See Note [Source locations for implicitly bound type variables].
       ; loc <- getSrcSpanM
       ; let loc' = noAnnSrcSpan loc
-       ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs
+       ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs

       ; bindLocalNamesFV vars $
         thing_inside vars }
@@ -647,8 +646,9 @@ rnHsTyKi env listTy@(HsListTy x ty)
 rnHsTyKi env (HsKindSig x ty k)
  = do { kind_sigs_ok <- xoptM LangExt.KindSignatures
       ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
-       ; (ty', lhs_fvs) <- rnLHsTyKi env ty
       ; (k', sig_fvs)  <- rnLHsTyKi (env { rtke_level = KindLevel }) k
+       ; (ty', lhs_fvs) <- bindSigTyVarsFV (hsScopedKvs k') $
+                           rnLHsTyKi env ty
       ; return (HsKindSig x ty' k', lhs_fvs `plusFV` sig_fvs) }

 -- Unboxed tuples are allowed to have poly-typed arguments.  These
@@ -1136,6 +1136,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside =
        thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField
                                       , hso_bndrs     = exp_bndrs' }

+-- See Note [Term variable capture and implicit quantification]
 warn_term_var_capture :: LocatedN RdrName -> RnM ()
 warn_term_var_capture lVar = do
    gbl_env <- getGlobalRdrEnv
@@ -1242,15 +1243,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn
 rnHsBndrVis HsBndrRequired = HsBndrRequired
 rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at

-newTyVarNameRn :: Maybe a -- associated class
-               -> LocatedN RdrName -> RnM Name
-newTyVarNameRn mb_assoc lrdr@(L _ rdr)
+newTyVarNameRn, newTyVarNameRnImplicit
+  :: Maybe a -- associated class
+  -> LocatedN RdrName -> RnM Name
+newTyVarNameRn         mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn
+newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr ->
+  do { warn_term_var_capture lrdr
+     ; newLocalBndrRn lrdr }
+
+new_tv_name_rn :: Maybe a -- associated class
+               -> (LocatedN RdrName -> RnM Name) -- how to create a new name
+               -> (LocatedN RdrName -> RnM Name)
+new_tv_name_rn Nothing  cont lrdr = cont lrdr
+new_tv_name_rn (Just _) cont lrdr@(L _ rdr)
  = do { rdr_env <- getLocalRdrEnv
-       ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of
-           (Just _, Just n) -> return n
-              -- Use the same Name as the parent class decl
+       ; case lookupLocalRdrEnv rdr_env rdr of
+           Just n -> return n -- Use the same Name as the parent class decl
+           _      -> cont lrdr }
+
+{- Note [Term variable capture and implicit quantification]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms",
+Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification
+
+Its purpose is to notify users when implicit quantification occurs that would
+stop working under RequiredTypeArguments (a future GHC extension). Example:
+
+   a = 42
+   id :: a -> a
+
+As it stands, the `a` in the signature `id :: a -> a` is considered free and
+leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`.
+Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`),
+leading to a type error.
+
+`warn_term_var_capture` detects this by demoting the namespace of the
+implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up
+in the environment. But when do we call `warn_term_var_capture`? It's tempting
+to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit
+variables:
+
+  rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
+    = do { let implicit_vs = nubN implicit_vs_with_dups
+         ; mapM_ warn_term_var_capture implicit_vs
+         ... }
+
+This approach generates false positives (#23434) because it misses a corner
+case: class variables in associated types. Consider the following example:
+
+  k = 12
+  class C k a where
+    type AT a :: k -> Type
+
+If we look at the signature for `AT` in isolation, the `k` looks like a free
+variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to
+`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning.
+But we don't want that: `k` is actually bound in the declaration header of the
+parent class.
+
+The solution is to check if it's a class variable (this is done in `new_tv_name_rn`)
+before we check for term variable capture.
+-}

-           _                -> newLocalBndrRn lrdr }
 {-
 *********************************************************
 *                                                       *
@@ -1937,8 +1991,7 @@ extract_lty (L _ ty) acc
      HsExplicitTupleTy _ tys     -> extract_ltys tys acc
      HsTyLit _ _                 -> acc
      HsStarTy _ _                -> acc
-      HsKindSig _ ty ki           -> extract_lty ty $
-                                     extract_lty ki acc
+      HsKindSig _ ty ki           -> extract_kind_sig ty ki acc
      HsForAllTy { hst_tele = tele, hst_body = ty }
                                  -> extract_hs_for_all_telescope tele acc $
                                     extract_lty ty []
@@ -1949,6 +2002,19 @@ extract_lty (L _ ty) acc
      -- We deal with these separately in rnLHsTypeWithWildCards
      HsWildCardTy {}             -> acc

+extract_kind_sig :: LHsType GhcPs -- type
+                 -> LHsType GhcPs -- kind
+                 -> FreeKiTyVars -> FreeKiTyVars
+extract_kind_sig ty ki acc
+  | (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }
+                    , hst_body = ki_body }) <- ki
+  = extract_hs_tv_bndrs bndrs acc $
+    extract_lty ty $
+    extract_lty ki_body []
+extract_kind_sig ty ki acc
+  = extract_lty ty $
+    extract_lty ki acc
+
 extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars
 extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
  extractHsOuterTvBndrs outer_bndrs $ extract_lty body []

--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1635,9 +1635,7 @@ There are four warning flags in play:
 -- inferred type of the function
 warnMissingSignatures :: TcGblEnv -> RnM ()
 warnMissingSignatures gbl_env
-  = do { warn_binds    <- woptM Opt_WarnMissingSignatures
-       ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures
-       ; let exports = availsToNameSet (tcg_exports gbl_env)
+  = do { let exports = availsToNameSet (tcg_exports gbl_env)
             sig_ns  = tcg_sigs gbl_env
               -- We use sig_ns to exclude top-level bindings that are generated by GHC
             binds    = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env
@@ -1652,7 +1650,7 @@ warnMissingSignatures gbl_env
               do { env <- liftZonkM $ tcInitTidyEnv -- Why not use emptyTidyEnv?
                  ; let (_, ty) = tidyOpenType env (idType id)
                        missing = MissingTopLevelBindingSig name ty
-                        diag = TcRnMissingSignature missing exported warn_binds
+                        diag = TcRnMissingSignature missing exported
                  ; addDiagnosticAt (getSrcSpan name) diag }
               where
                 name = idName id
@@ -1664,7 +1662,7 @@ warnMissingSignatures gbl_env
             add_patsyn_warn ps =
               when (not_ghc_generated name) $
                 addDiagnosticAt (getSrcSpan name)
-                  (TcRnMissingSignature missing exported warn_pat_syns)
+                  (TcRnMissingSignature missing exported)
               where
                 name = patSynName ps
                 missing = MissingPatSynSig ps
@@ -1691,16 +1689,17 @@ warnMissingKindSignatures gbl_env
    tcs = tcg_tcs gbl_env
    ksig_ns = tcg_ksigs gbl_env
    exports = availsToNameSet (tcg_exports gbl_env)
-    not_ghc_generated :: Name -> Bool
-    not_ghc_generated name = name `elemNameSet` ksig_ns
+
+    has_kind_signature :: Name -> Bool
+    has_kind_signature name = name `elemNameSet` ksig_ns

    add_ty_warn :: Bool -> TyCon -> RnM ()
    add_ty_warn cusks_enabled tyCon =
-      when (not_ghc_generated name) $
+      when (has_kind_signature name) $
        addDiagnosticAt (getSrcSpan name) diag
      where
        name = tyConName tyCon
-        diag = TcRnMissingSignature missing exported False
+        diag = TcRnMissingSignature missing exported
        missing = MissingTyConKindSig tyCon cusks_enabled
        exported = if name `elemNameSet` exports
                   then IsExported

--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -65,6 +65,7 @@ import GHC.Utils.Logger
 import GHC.Data.Bag
 import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs)
 import qualified GHC.LanguageExtensions as LangExt
+import GHC.Data.BooleanFormula ( isUnsatisfied )

 import Control.Monad
 import Control.Monad.Trans.Class
@@ -1442,19 +1443,24 @@ mk_eqn_no_strategy = do
                 -- See Note [DerivEnv and DerivSpecMechanism] in GHC.Tc.Deriv.Utils
                 whenIsJust (hasStockDeriving cls) $ \_ ->
                   expectNonDataFamTyCon dit
-                 mk_eqn_originative dit
+                 mk_eqn_originative cls dit

     |  otherwise
     -> mk_eqn_anyclass
  where
    -- Use heuristics (checkOriginativeSideConditions) to determine whether
    -- stock or anyclass deriving should be used.
-    mk_eqn_originative :: DerivInstTys -> DerivM EarlyDerivSpec
-    mk_eqn_originative dit@(DerivInstTys { dit_tc     = tc
-                                         , dit_rep_tc = rep_tc }) = do
+    mk_eqn_originative :: Class -> DerivInstTys -> DerivM EarlyDerivSpec
+    mk_eqn_originative cls dit@(DerivInstTys { dit_tc     = tc
+                                             , dit_rep_tc = rep_tc }) = do
      dflags <- getDynFlags
-      let isDeriveAnyClassEnabled =
-            deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
+      let isDeriveAnyClassEnabled
+            | canSafelyDeriveAnyClass cls
+            = deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
+            | otherwise
+            -- Pretend that the extension is enabled so that we won't suggest
+            -- enabling it.
+            = YesDeriveAnyClassEnabled

      -- See Note [Deriving instances for classes themselves]
      let dac_error
@@ -1471,6 +1477,12 @@ mk_eqn_no_strategy = do
                                                 , dsm_stock_gen_fns = gen_fns }
        CanDeriveAnyClass      -> mk_eqn_from_mechanism DerivSpecAnyClass

+    canSafelyDeriveAnyClass cls =
+      -- If the set of minimal required definitions is nonempty,
+      -- `DeriveAnyClass` will generate an instance with undefined methods or
+      -- associated types, so don't suggest enabling it.
+      isNothing $ isUnsatisfied (const False) (classMinimalDef cls)
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1960,9 +1972,13 @@ doDerivInstErrorChecks1 mechanism =
  case mechanism of
    DerivSpecStock{dsm_stock_dit = dit}
      -> data_cons_in_scope_check dit
-    DerivSpecNewtype{dsm_newtype_dit = dit}
-      -> do atf_coerce_based_error_checks
-            data_cons_in_scope_check dit
+    -- No need to 'data_cons_in_scope_check' for newtype deriving.
+    -- Additionally, we also don't need to mark the constructos as
+    -- used because newtypes are handled separately elsewhere.
+    -- See Note [Tracking unused binding and imports] in GHC.Tc.Types
+    -- or #17328 for more.
+    DerivSpecNewtype{}
+      -> atf_coerce_based_error_checks
    DerivSpecAnyClass{}
      -> pure ()
    DerivSpecVia{}

--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -352,8 +352,9 @@ reportImplic ctxt implic@(Implic { ic_skols  = tvs
               -- Do /not/ use the tidied tvs because then are in the
               -- wrong order, so tidying will rename things wrongly
       ; reportWanteds ctxt' tc_lvl wanted
-       ; when (cec_warn_redundant ctxt) $
-         warnRedundantConstraints ctxt' ct_loc_env info' dead_givens }
+
+       -- Report redundant (unused) constraints
+       ; warnRedundantConstraints ctxt' ct_loc_env info' dead_givens }
  where
    insoluble    = isInsolubleStatus status
    (env1, tvs') = tidyVarBndrs (cec_tidy ctxt) $
@@ -390,9 +391,19 @@ reportImplic ctxt implic@(Implic { ic_skols  = tvs
 warnRedundantConstraints :: SolverReportErrCtxt -> CtLocEnv -> SkolemInfoAnon -> [EvVar] -> TcM ()
 -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
 warnRedundantConstraints ctxt env info redundant_evs
+ | not (cec_warn_redundant ctxt)
+ = return ()
+
 | null redundant_evs
 = return ()

+ -- Do not report redundant constraints for quantified constraints
+ -- See (RC4) in Note [Tracking redundant constraints]
+ -- Fortunately it is easy to spot implications constraints that arise
+ -- from quantified constraints, from their SkolInfo
+ | InstSkol (IsQC {}) _ <- info
+ = return ()
+
 | SigSkol user_ctxt _ _ <- info
 -- When dealing with a user-written type signature,
 -- we want to add "In the type signature for f".
@@ -404,7 +415,7 @@ warnRedundantConstraints ctxt env info redundant_evs
 -- "In the instance declaration for Eq [a]" context
 -- and we don't want to say it twice. Seems a bit ad-hoc
 = report_redundant_msg False env
-                 --   ^^^^^ don't add "In the type signature..."
+                   --   ^^^^^ don't add "In the type signature..."
 where
   report_redundant_msg :: Bool -- whether to add "In the type signature..." to the diagnostic
                        -> CtLocEnv

--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -352,7 +352,7 @@ instance Diagnostic TcRnMessage where
              = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ]
              | otherwise
              = empty
-    TcRnMissingSignature what _ _ ->
+    TcRnMissingSignature what _ ->
      mkSimpleDecorated $
      case what of
        MissingPatSynSig p ->
@@ -1046,6 +1046,7 @@ instance Diagnostic TcRnMessage where
                     ClassPE        -> same_rec_group_msg
                     TyConPE        -> same_rec_group_msg
                     TermVariablePE -> text "term variables cannot be promoted"
+                     TypeVariablePE -> text "type variables bound in a kind signature cannot be used in the type"
          same_rec_group_msg = text "it is defined and used in the same recursive group"
    TcRnMatchesHaveDiffNumArgs argsContext (MatchArgMatches match1 bad_matches)
      -> mkSimpleDecorated $
@@ -1939,8 +1940,8 @@ instance Diagnostic TcRnMessage where
      -> ErrorWithoutFlag
    TcRnPartialTypeSigBadQuantifier{}
      -> ErrorWithoutFlag
-    TcRnMissingSignature what exported overridden
-      -> WarningWithFlag $ missingSignatureWarningFlag what exported overridden
+    TcRnMissingSignature what exported
+      -> WarningWithFlags $ missingSignatureWarningFlags what exported
    TcRnPolymorphicBinderMissingSig{}
      -> WarningWithFlag Opt_WarnMissingLocalSignatures
    TcRnOverloadedSig{}
@@ -3310,22 +3311,19 @@ formatExportItemError exportedThing reason =
       , quotes exportedThing
       , text reason ]

-- | What warning flag is associated with the given missing signature?
-missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
-missingSignatureWarningFlag (MissingTopLevelBindingSig {}) exported overridden
-  | IsExported <- exported
-  , not overridden
-  = Opt_WarnMissingExportedSignatures
-  | otherwise
-  = Opt_WarnMissingSignatures
-missingSignatureWarningFlag (MissingPatSynSig {}) exported overridden
-  | IsExported <- exported
-  , not overridden
-  = Opt_WarnMissingExportedPatternSynonymSignatures
-  | otherwise
-  = Opt_WarnMissingPatternSynonymSignatures
-missingSignatureWarningFlag (MissingTyConKindSig {}) _ _
-  = Opt_WarnMissingKindSignatures
+-- | What warning flags are associated with the given missing signature?
+missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag
+missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported
+  -- We prefer "bigger" warnings first: #14794
+  --
+  -- See Note [Warnings controlled by multiple flags]
+  = Opt_WarnMissingSignatures :|
+    [ Opt_WarnMissingExportedSignatures | IsExported == exported ]
+missingSignatureWarningFlags (MissingPatSynSig {}) exported
+  = Opt_WarnMissingPatternSynonymSignatures :|
+    [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported  == exported ]
+missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _
+  = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ]

 useDerivingStrategies :: GhcHint
 useDerivingStrategies =

--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -523,10 +523,13 @@ data TcRnMessage where
      a warning is declared twice.

      Examples(s):
-        None.
+        {-# DEPRECATED foo "Don't use me" #-}
+        {-# DEPRECATED foo "Don't use me" #-}
+        foo :: Int
+        foo = 2

     Test cases:
-        None.
+        rename/should_fail/rnfail058
  -}
  TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage

@@ -933,6 +936,7 @@ data TcRnMessage where
        -Wmissing-pattern-synonym-signatures
        -Wmissing-exported-pattern-synonym-signatures
        -Wmissing-kind-signatures
+        -Wmissing-poly-kind-signatures

      Test cases:
        T11077 (top-level bindings)
@@ -941,8 +945,6 @@ data TcRnMessage where
  -}
  TcRnMissingSignature :: MissingSignature
                       -> Exported
-                       -> Bool -- ^ True: -Wmissing-signatures overrides -Wmissing-exported-signatures,
-                               --     or -Wmissing-pattern-synonym-signatures overrides -Wmissing-exported-pattern-synonym-signatures
                       -> TcRnMessage

  {-| TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures
@@ -2369,6 +2371,9 @@ data TcRnMessage where
                saks/should_fail/T16727a
                saks/should_fail/T16727b
                rename/should_fail/T12686
+                rename/should_fail/T16635a
+                rename/should_fail/T16635b
+                rename/should_fail/T16635c
  -}
  TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage

@@ -4494,6 +4499,7 @@ data MissingSignature
 data Exported
  = IsNotExported
  | IsExported
+  deriving Eq

 instance Outputable Exported where
  ppr IsNotExported = text "IsNotExported"
No results found