[Git][ghc/ghc][wip/T22948] Disallow `tagToEnum#` on type data types

[Ryan Scott (@RyanGlScott)]

Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC


Commits:
24bbdc3c by Ryan Scott at 2023-02-12T08:42:25-05:00
Disallow `tagToEnum#` on type data types

We don't want to allow users to conjure up values of a `type data` type using
`tagToEnum#`, as these simply don't exist at the value level.

- - - - -


8 changed files:

- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Types/Error/Codes.hs
- + testsuite/tests/type-data/should_fail/TDTagToEnum.hs
- + testsuite/tests/type-data/should_fail/TDTagToEnum.stderr
- testsuite/tests/type-data/should_fail/all.T


Changes:

=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2161,6 +2161,15 @@ The main parts of the implementation are:
   During checking the coverage of `f`'s pattern matches, we treat `T` as if it
   were an empty data type so that GHC does not warn the user to match against
   `A` or `B`.
+
+* To prevent users from conjuring up `type data` values at the term level, we
+  disallow using the tagToEnum# function on a type headed by a `type data`
+  type. For instance, GHC will reject this code:
+
+    type data Letter = A | B | C
+
+    f :: Letter
+    f = tagToEnum# 0#
 -}
 
 warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -276,6 +276,10 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
            hang (text "Bad call to tagToEnum# at type" <+> ppr ty)
               2 (text "Result type must be an enumeration type")
+    TcRnTagToEnumResTyTypeData ty
+      -> mkSimpleDecorated $
+           hang (text "Bad call to tagToEnum# at type" <+> ppr ty)
+              2 (text "Result type cannot be headed by a `type data` type")
     TcRnArrowIfThenElsePredDependsOnResultTy
       -> mkSimpleDecorated $
            text "Predicate type of `ifThenElse' depends on result type"
@@ -1379,6 +1383,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnTagToEnumResTyNotAnEnum{}
       -> ErrorWithoutFlag
+    TcRnTagToEnumResTyTypeData{}
+      -> ErrorWithoutFlag
     TcRnArrowIfThenElsePredDependsOnResultTy
       -> ErrorWithoutFlag
     TcRnIllegalHsBootFileDecl
@@ -1807,6 +1813,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnTagToEnumResTyNotAnEnum{}
       -> noHints
+    TcRnTagToEnumResTyTypeData{}
+      -> noHints
     TcRnArrowIfThenElsePredDependsOnResultTy
       -> noHints
     TcRnIllegalHsBootFileDecl


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -665,6 +665,20 @@ data TcRnMessage where
   -}
   TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage
 
+  {-| TcRnTagToEnumResTyTypeData is an error that occurs when the 'tagToEnum#'
+      function is given a result type that is headed by a @type data@ type, as
+      the data constructors of a @type data@ do not exist at the term level.
+
+      Example(s):
+      type data Letter = A | B | C
+
+      foo :: Letter
+      foo = tagToEnum# 0#
+
+     Test cases: type-data/should_fail/TDTagToEnum.hs
+  -}
+  TcRnTagToEnumResTyTypeData :: Type -> TcRnMessage
+
   {-| TcRnArrowIfThenElsePredDependsOnResultTy is an error that occurs when the
       predicate type of an ifThenElse expression in arrow notation depends on
       the type of the result.


=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -1226,6 +1226,7 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty
     vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty
 
     check_enumeration ty' tc
+      | isTypeDataTyCon tc    = addErrTc (TcRnTagToEnumResTyTypeData ty')
       | isEnumerationTyCon tc = return ()
       | otherwise             = addErrTc (TcRnTagToEnumResTyNotAnEnum ty')
 


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -354,6 +354,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnTagToEnumMissingValArg"                    = 36495
   GhcDiagnosticCode "TcRnTagToEnumUnspecifiedResTy"                 = 08522
   GhcDiagnosticCode "TcRnTagToEnumResTyNotAnEnum"                   = 49356
+  GhcDiagnosticCode "TcRnTagToEnumResTyTypeData"                    = 96189
   GhcDiagnosticCode "TcRnArrowIfThenElsePredDependsOnResultTy"      = 55868
   GhcDiagnosticCode "TcRnIllegalHsBootFileDecl"                     = 58195
   GhcDiagnosticCode "TcRnRecursivePatternSynonym"                   = 72489


=====================================
testsuite/tests/type-data/should_fail/TDTagToEnum.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeData #-}
+module TDTagToEnum where
+
+import GHC.Exts (tagToEnum#)
+
+type data Letter = A | B | C
+
+f :: Letter
+f = tagToEnum# 0#


=====================================
testsuite/tests/type-data/should_fail/TDTagToEnum.stderr
=====================================
@@ -0,0 +1,6 @@
+
+TDTagToEnum.hs:10:5: error: [GHC-96189]
+    • Bad call to tagToEnum# at type Letter
+        Result type cannot be headed by a `type data` type
+    • In the expression: tagToEnum# 0#
+      In an equation for ‘f’: f = tagToEnum# 0#


=====================================
testsuite/tests/type-data/should_fail/all.T
=====================================
@@ -11,4 +11,5 @@ test('TDRecordsH98', normal, compile_fail, [''])
 test('TDRecursive', normal, compile_fail, [''])
 test('TDStrictnessGADT', normal, compile_fail, [''])
 test('TDStrictnessH98', normal, compile_fail, [''])
+test('TDTagToEnum', normal, compile_fail, [''])
 test('T22332b', normal, compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24bbdc3c861a495b5f4aba105227c480d14ca9b2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24bbdc3c861a495b5f4aba105227c480d14ca9b2
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/20230212/a36bbdba/attachment-0001.html>