diff options
| author | Zachary Wood <zac.wood9@gmail.com> | 2022-08-14 22:13:38 -0700 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-08-19 14:17:28 -0400 |
| commit | 9789e8454ad9f315169063b344a56c4216c12711 (patch) | |
| tree | d1abe617870bfcb673f8a7a18dc91c68df49cec5 /compiler | |
| parent | 9a7e2ea1684c3a3ac91e4cdbb07b9d217f58dd4c (diff) | |
| download | haskell-9789e8454ad9f315169063b344a56c4216c12711.tar.gz | |
tc: warn about lazy annotations on unlifted arguments (fixes #21951)
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Tc/TyCl.hs | 6 |
3 files changed, 24 insertions, 0 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 349f587ddc..e688010f8d 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -445,6 +445,9 @@ instance Diagnostic TcRnMessage where TcRnBangOnUnliftedType ty -> mkSimpleDecorated $ text "Strictness flag has no effect on unlifted type" <+> quotes (ppr ty) + TcRnLazyBangOnUnliftedType ty + -> mkSimpleDecorated $ + text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty) TcRnMultipleDefaultDeclarations dup_things -> mkSimpleDecorated $ hang (text "Multiple default declarations") @@ -1094,6 +1097,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnBangOnUnliftedType{} -> WarningWithFlag Opt_WarnRedundantStrictnessFlags + TcRnLazyBangOnUnliftedType{} + -> WarningWithFlag Opt_WarnRedundantStrictnessFlags TcRnMultipleDefaultDeclarations{} -> ErrorWithoutFlag TcRnBadDefaultType{} @@ -1424,6 +1429,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnBangOnUnliftedType{} -> noHints + TcRnLazyBangOnUnliftedType{} + -> noHints TcRnMultipleDefaultDeclarations{} -> noHints TcRnBadDefaultType{} diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 96bf0b7127..7c2b22d765 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -1133,6 +1133,17 @@ data TcRnMessage where -} TcRnBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnLazyBangOnUnliftedType is a warning (controlled by -Wredundant-strictness-flags) that + occurs when a lazy annotation is applied to an unlifted type. + + Example(s): + data T = MkT ~Int# -- Lazy flag has no effect on unlifted types + + Test cases: typecheck/should_compile/T21951a + typecheck/should_compile/T21951b + -} + TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnMultipleDefaultDeclarations is an error that occurs when a module has more than one default declaration. diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 145f1b26f2..ee9314e74b 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -4441,6 +4441,12 @@ checkValidDataCon dflags existential_ok tc con , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnBangOnUnliftedType orig_arg_ty + -- Warn about a ~ on an unlifted type (#21951) + -- e.g. data T = MkT ~Int# + | HsSrcBang _ _ SrcLazy <- bang + , isUnliftedType orig_arg_ty + = addDiagnosticTc $ TcRnLazyBangOnUnliftedType orig_arg_ty + | HsSrcBang _ want_unpack _ <- bang , isSrcUnpacked want_unpack , case rep_bang of { HsUnpack {} -> False; _ -> True } |