summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename/Names.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Rename/Names.hs')
-rw-r--r--compiler/GHC/Rename/Names.hs28
1 files changed, 27 insertions, 1 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 6c99bf7b5b..835e39a246 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -52,6 +52,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Core.Type
import GHC.Core.PatSyn
import GHC.Core.TyCo.Ppr
+import GHC.Core.TyCon ( TyCon, tyConName, tyConKind )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
@@ -1417,7 +1418,8 @@ reportUnusedNames gbl_env hsc_src
; traceRn "RUN" (ppr (tcg_dus gbl_env))
; warnUnusedImportDecls gbl_env hsc_src
; warnUnusedTopBinds $ unused_locals keep
- ; warnMissingSignatures gbl_env }
+ ; warnMissingSignatures gbl_env
+ ; warnMissingKindSignatures gbl_env }
where
used_names :: NameSet -> NameSet
used_names keep = findUses (tcg_dus gbl_env) emptyNameSet `unionNameSet` keep
@@ -1519,6 +1521,30 @@ warnMissingSignatures gbl_env
; add_sig_warns }
+-- | Warn the user about tycons that lack kind signatures.
+-- Called /after/ type (and kind) inference, so that we can report the
+-- inferred kinds.
+warnMissingKindSignatures :: TcGblEnv -> RnM ()
+warnMissingKindSignatures gbl_env
+ = do { warn_missing_kind_sigs <- woptM Opt_WarnMissingKindSignatures
+ ; cusks_enabled <- xoptM LangExt.CUSKs
+ ; when (warn_missing_kind_sigs) (mapM_ (add_ty_warn cusks_enabled) tcs)
+ }
+ where
+ tcs = tcg_tcs gbl_env
+ ksig_ns = tcg_ksigs gbl_env
+
+ add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
+ add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $
+ addWarnAt (Reason Opt_WarnMissingKindSignatures) (getSrcSpan name) $
+ hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
+ where
+ msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
+ | otherwise = text "Top-level type constructor with no standalone kind signature:"
+ name = tyConName tyCon
+ ki = tyConKind tyCon
+ ki_msg :: SDoc
+ ki_msg = pprKind ki
{-
*********************************************************