[Git][ghc/ghc][master] tc: warn about lazy annotations on unlifted arguments (fixes #21951)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00
tc: warn about lazy annotations on unlifted arguments (fixes #21951)

- - - - -


8 changed files:

- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/TyCl.hs
- + testsuite/tests/typecheck/should_compile/T21951a.hs
- + testsuite/tests/typecheck/should_compile/T21951a.stderr
- + testsuite/tests/typecheck/should_compile/T21951b.hs
- + testsuite/tests/typecheck/should_compile/T21951b.stderr
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
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{}


=====================================
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.
 


=====================================
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 }


=====================================
testsuite/tests/typecheck/should_compile/T21951a.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnliftedDatatypes #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE MagicHash #-}
+
+module Wibble where
+
+import Data.Kind
+import GHC.Exts
+
+data UA = UA ~(Array# Int)


=====================================
testsuite/tests/typecheck/should_compile/T21951a.stderr
=====================================
@@ -0,0 +1,4 @@
+T21951a.hs:10:11: warning: [-Wredundant-strictness-flags]
+     Lazy flag has no effect on unlifted type ‘Array# Int’
+     In the definition of data constructor ‘UA’
+      In the data type declaration for ‘UA’


=====================================
testsuite/tests/typecheck/should_compile/T21951b.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE UnliftedDatatypes #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE MagicHash #-}
+
+module Wibble where
+
+import Data.Kind
+import GHC.Exts
+
+type U :: UnliftedType
+data U = MkU Int
+
+data T = T ~U


=====================================
testsuite/tests/typecheck/should_compile/T21951b.stderr
=====================================
@@ -0,0 +1,4 @@
+T21951b.hs:13:10: warning: [-Wredundant-strictness-flags]
+     Lazy flag has no effect on unlifted type ‘U’
+     In the definition of data constructor ‘T’
+      In the data type declaration for ‘T’


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -853,3 +853,5 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98'])
 test('DeepSubsumption07', normal, compile, ['-XHaskell2010'])
 test('DeepSubsumption08', normal, compile, [''])
 test('DeepSubsumption09', normal, compile, [''])
+test('T21951a', normal, compile, ['-Wredundant-strictness-flags'])
+test('T21951b', normal, compile, ['-Wredundant-strictness-flags'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9789e8454ad9f315169063b344a56c4216c12711

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9789e8454ad9f315169063b344a56c4216c12711
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220819/e8337111/attachment-0001.html>