summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Core/DataCon.hs8
-rw-r--r--compiler/GHC/Driver/Session.hs1
-rw-r--r--compiler/GHC/Hs/Decls.hs7
-rw-r--r--compiler/GHC/HsToCore/Quote.hs2
-rw-r--r--compiler/GHC/Parser.y17
-rw-r--r--compiler/GHC/Parser/PostProcess.hs30
-rw-r--r--compiler/GHC/Rename/Module.hs120
-rw-r--r--compiler/GHC/Rename/Names.hs6
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs15
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs41
-rw-r--r--compiler/GHC/Tc/TyCl.hs27
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs2
-rw-r--r--compiler/GHC/ThToHs.hs6
-rw-r--r--compiler/GHC/Types/Error/Codes.hs2
-rw-r--r--compiler/GHC/Types/TyThing.hs16
-rw-r--r--compiler/Language/Haskell/Syntax/Decls.hs23
-rw-r--r--docs/users_guide/9.6.1-notes.rst6
-rw-r--r--docs/users_guide/exts/data_kinds.rst1
-rw-r--r--docs/users_guide/exts/type_data.rst60
-rw-r--r--docs/users_guide/exts/types.rst1
m---------libraries/Cabal0
-rw-r--r--libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs1
-rw-r--r--testsuite/tests/driver/T4437.hs1
-rw-r--r--testsuite/tests/ghc-api/exactprint/Test20239.stderr1
-rw-r--r--testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr6
-rw-r--r--testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr1
-rw-r--r--testsuite/tests/parser/should_compile/DumpParsedAst.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr1
-rw-r--r--testsuite/tests/parser/should_compile/T15323.stderr1
-rw-r--r--testsuite/tests/parser/should_compile/T20452.stderr2
-rw-r--r--testsuite/tests/printer/T18791.stderr1
-rw-r--r--testsuite/tests/type-data/Makefile3
-rw-r--r--testsuite/tests/type-data/should_compile/Makefile3
-rw-r--r--testsuite/tests/type-data/should_compile/TDDataConstructor.hs5
-rw-r--r--testsuite/tests/type-data/should_compile/TDExistential.hs13
-rw-r--r--testsuite/tests/type-data/should_compile/TDGoodConsConstraints.hs10
-rw-r--r--testsuite/tests/type-data/should_compile/TDVector.hs21
-rw-r--r--testsuite/tests/type-data/should_compile/all.T4
-rw-r--r--testsuite/tests/type-data/should_fail/Makefile3
-rw-r--r--testsuite/tests/type-data/should_fail/TDBadConsConstraint.hs8
-rw-r--r--testsuite/tests/type-data/should_fail/TDBadConsConstraint.stderr5
-rw-r--r--testsuite/tests/type-data/should_fail/TDDeriving.hs5
-rw-r--r--testsuite/tests/type-data/should_fail/TDDeriving.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/TDExpression.hs7
-rw-r--r--testsuite/tests/type-data/should_fail/TDExpression.stderr6
-rw-r--r--testsuite/tests/type-data/should_fail/TDMultiple01.hs5
-rw-r--r--testsuite/tests/type-data/should_fail/TDMultiple01.stderr5
-rw-r--r--testsuite/tests/type-data/should_fail/TDMultiple02.hs5
-rw-r--r--testsuite/tests/type-data/should_fail/TDMultiple02.stderr5
-rw-r--r--testsuite/tests/type-data/should_fail/TDNoPragma.hs4
-rw-r--r--testsuite/tests/type-data/should_fail/TDNoPragma.stderr4
-rw-r--r--testsuite/tests/type-data/should_fail/TDPattern.hs7
-rw-r--r--testsuite/tests/type-data/should_fail/TDPattern.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/TDPunning.hs4
-rw-r--r--testsuite/tests/type-data/should_fail/TDPunning.stderr5
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecordsGADT.hs6
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecordsGADT.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecordsH98.hs4
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecordsH98.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecursive.hs4
-rw-r--r--testsuite/tests/type-data/should_fail/TDRecursive.stderr7
-rw-r--r--testsuite/tests/type-data/should_fail/TDStrictnessGADT.hs5
-rw-r--r--testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/TDStrictnessH98.hs4
-rw-r--r--testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr3
-rw-r--r--testsuite/tests/type-data/should_fail/all.T13
-rw-r--r--utils/check-exact/ExactPrint.hs2
m---------utils/haddock0
69 files changed, 575 insertions, 35 deletions
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index d8b26558aa..e50290a5f8 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -57,7 +57,8 @@ module GHC.Core.DataCon (
isNullarySrcDataCon, isNullaryRepDataCon,
isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon,
isUnboxedSumDataCon,
- isVanillaDataCon, isNewDataCon, classDataCon, dataConCannotMatch,
+ isVanillaDataCon, isNewDataCon, isTypeDataCon,
+ classDataCon, dataConCannotMatch,
dataConUserTyVarsArePermuted,
isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc,
@@ -1634,6 +1635,11 @@ isVanillaDataCon dc = dcVanilla dc
isNewDataCon :: DataCon -> Bool
isNewDataCon dc = isNewTyCon (dataConTyCon dc)
+-- | Is this data constructor in a "type data" declaration?
+-- See Note [Type data declarations] in GHC.Rename.Module.
+isTypeDataCon :: DataCon -> Bool
+isTypeDataCon dc = isTcClsNameSpace (nameNameSpace (getName dc))
+
-- | Should this DataCon be allowed in a type even without -XDataKinds?
-- Currently, only Lifted & Unlifted
specialPromotedDc :: DataCon -> Bool
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 38bb6598b4..017b8bce20 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3759,6 +3759,7 @@ xFlagsDeps = [
flagSpec "TransformListComp" LangExt.TransformListComp,
flagSpec "TupleSections" LangExt.TupleSections,
flagSpec "TypeApplications" LangExt.TypeApplications,
+ flagSpec "TypeData" LangExt.TypeData,
depFlagSpec' "TypeInType" LangExt.TypeInType
(deprecatedForExtensions ["DataKinds", "PolyKinds"]),
flagSpec "TypeFamilies" LangExt.TypeFamilies,
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 1db54bfc4b..c4a79f25a7 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -401,7 +401,7 @@ countTyClDecls decls
count isNewTy decls, -- ...instances
count isFamilyDecl decls)
where
- isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_cons = DataTypeCons _ } } = True
+ isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_cons = DataTypeCons _ _ } } = True
isDataTy _ = False
isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_cons = NewTypeCon _ } } = True
@@ -698,8 +698,11 @@ ppDataDefnHeader pp_hdr HsDataDefn
, dd_cType = mb_ct
, dd_kindSig = mb_sig
, dd_cons = condecls }
- = ppr (dataDefnConsNewOrData condecls) <+> pp_ct <+> pp_hdr context <+> pp_sig
+ = pp_type <+> ppr (dataDefnConsNewOrData condecls) <+> pp_ct <+> pp_hdr context <+> pp_sig
where
+ pp_type
+ | isTypeDataDefnCons condecls = text "type"
+ | otherwise = empty
pp_ct = case mb_ct of
Nothing -> empty
Just ct -> ppr ct
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index e6f8ce4c51..c707a29368 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -527,7 +527,7 @@ repDataDefn tc opts
; ksig' <- repMaybeLTy ksig
; repNewtype cxt1 tc opts ksig' con'
derivs1 }
- DataTypeCons cons -> do { ksig' <- repMaybeLTy ksig
+ DataTypeCons _ cons -> do { ksig' <- repMaybeLTy ksig
; consL <- mapM repC cons
; cons1 <- coreListM conTyConName consL
; repData cxt1 tc opts ksig' cons1
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index e530750745..fd1cd5d3ae 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1271,22 +1271,22 @@ ty_decl :: { LTyClDecl GhcPs }
++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
-- ordinary data type or newtype declaration
- | data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
- {% mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
+ | type_data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
+ {% mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
Nothing (reverse (snd $ unLoc $4))
(fmap reverse $5)
- ((fst $ unLoc $1):(fst $ unLoc $4)) }
+ ((fstOf3 $ unLoc $1):(fst $ unLoc $4)) }
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
-- ordinary GADT declaration
- | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
+ | type_data_or_newtype capi_ctype tycl_hdr opt_kind_sig
gadt_constrlist
maybe_derivings
- {% mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
+ {% mkTyData (comb4 $1 $3 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
(snd $ unLoc $4) (snd $ unLoc $5)
(fmap reverse $6)
- ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
+ ((fstOf3 $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
@@ -1510,6 +1510,11 @@ at_decl_inst :: { LInstDecl GhcPs }
(fmap reverse $7)
((fst $ unLoc $1):$2++(fst $ unLoc $5)++(fst $ unLoc $6)) }
+type_data_or_newtype :: { Located (AddEpAnn, Bool, NewOrData) }
+ : 'data' { sL1 $1 (mj AnnData $1,False,DataType) }
+ | 'newtype' { sL1 $1 (mj AnnNewtype $1,False,NewType) }
+ | 'type' 'data' { sL1 $1 (mj AnnData $1,True ,DataType) }
+
data_or_newtype :: { Located (AddEpAnn, NewOrData) }
: 'data' { sL1 $1 (mj AnnData $1,DataType) }
| 'newtype' { sL1 $1 (mj AnnNewtype $1,NewType) }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 928e7ce4aa..ced580d743 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -215,6 +215,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn
, tcdDocs = docs })) }
mkTyData :: SrcSpan
+ -> Bool
-> NewOrData
-> Maybe (LocatedP CType)
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
@@ -223,14 +224,14 @@ mkTyData :: SrcSpan
-> Located (HsDeriving GhcPs)
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
-mkTyData loc' new_or_data cType (L _ (mcxt, tycl_hdr))
+mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr))
ksig data_cons (L _ maybe_deriv) annsIn
= do { let loc = noAnnSrcSpan loc'
; (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams
; cs <- getCommentsFor (locA loc) -- Get any remaining comments
; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) ann cs
- ; data_cons <- checkNewOrData (locA loc) (unLoc tc) new_or_data data_cons
+ ; data_cons <- checkNewOrData (locA loc) (unLoc tc) is_type_data new_or_data data_cons
; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
; return (L loc (DataDecl { tcdDExt = anns',
tcdLName = tc, tcdTyVars = tyvars,
@@ -252,7 +253,6 @@ mkDataDefn cType mcxt ksig data_cons maybe_deriv
, dd_kindSig = ksig
, dd_derivs = maybe_deriv }) }
-
mkTySynonym :: SrcSpan
-> LHsType GhcPs -- LHS
-> LHsType GhcPs -- RHS
@@ -327,7 +327,7 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan
; let fam_eqn_ans = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments
- ; data_cons <- checkNewOrData loc (unLoc tc) new_or_data data_cons
+ ; data_cons <- checkNewOrData loc (unLoc tc) False new_or_data data_cons
; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
; return (L (noAnnSrcSpan loc) (DataFamInstD noExtField (DataFamInstDecl
(FamEqn { feqn_ext = fam_eqn_ans
@@ -2622,11 +2622,27 @@ mkOpaquePragma src
, inl_rule = FunLike
}
-checkNewOrData :: SrcSpan -> RdrName -> NewOrData -> [a] -> P (DataDefnCons a)
-checkNewOrData span name = curry $ \ case
+checkNewOrData :: SrcSpan -> RdrName -> Bool -> NewOrData -> [LConDecl GhcPs]
+ -> P (DataDefnCons (LConDecl GhcPs))
+checkNewOrData span name is_type_data = curry $ \ case
(NewType, [a]) -> pure $ NewTypeCon a
- (DataType, as) -> pure $ DataTypeCons as
+ (DataType, as) -> pure $ DataTypeCons is_type_data (handle_type_data as)
(NewType, as) -> addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrMultipleConForNewtype name (length as)
+ where
+ -- In a "type data" declaration, the constructors are in the type/class
+ -- namespace rather than the data constructor namespace.
+ -- See Note [Type data declarations] in GHC.Rename.Module.
+ handle_type_data
+ | is_type_data = map (fmap promote_constructor)
+ | otherwise = id
+
+ promote_constructor (dc@ConDeclGADT { con_names = cons })
+ = dc { con_names = fmap (fmap promote_name) cons }
+ promote_constructor (dc@ConDeclH98 { con_name = con })
+ = dc { con_name = fmap promote_name con }
+ promote_constructor dc = dc
+
+ promote_name name = fromMaybe name (promoteRdrName name)
-----------------------------------------------------------------------------
-- utilities for foreign declarations
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 7e2c4a0388..6748d60a56 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -69,6 +69,7 @@ import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
import GHC.Types.Unique.Set
import GHC.Data.OrdList
import qualified GHC.LanguageExtensions as LangExt
+import GHC.Core.DataCon ( isSrcStrict )
import Control.Monad
import Control.Arrow ( first )
@@ -1948,6 +1949,10 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
checkTc (h98_style || null (fromMaybeContext context))
(badGadtStupidTheta doc)
+ -- Check restrictions on "type data" declarations.
+ -- See Note [Type data declarations].
+ ; when (isTypeDataDefnCons condecls) check_type_data
+
; (m_sig', sig_fvs) <- case m_sig of
Just sig -> first Just <$> rnLHsKind doc sig
Nothing -> return (Nothing, emptyFVs)
@@ -1982,6 +1987,121 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds
; return (ds', fvs) }
+ -- Given a "type data" declaration, check that the TypeData extension
+ -- is enabled and check restrictions (R1), (R2), (R3) and (R5)
+ -- on the declaration. See Note [Type data declarations].
+ check_type_data
+ = do { unlessXOptM LangExt.TypeData $ failWith TcRnIllegalTypeData
+ ; unless (null (fromMaybeContext context)) $
+ failWith $ TcRnTypeDataForbids TypeDataForbidsDatatypeContexts
+ ; mapM_ (addLocMA check_type_data_condecl) condecls
+ ; unless (null derivs) $
+ failWith $ TcRnTypeDataForbids TypeDataForbidsDerivingClauses
+ }
+
+ -- Check restrictions (R2) and (R3) on a "type data" constructor.
+ -- See Note [Type data declarations].
+ check_type_data_condecl :: ConDecl GhcPs -> RnM ()
+ check_type_data_condecl condecl
+ = do {
+ ; when (has_labelled_fields condecl) $
+ failWith $ TcRnTypeDataForbids TypeDataForbidsLabelledFields
+ ; when (has_strictness_flags condecl) $
+ failWith $ TcRnTypeDataForbids TypeDataForbidsStrictnessAnnotations
+ }
+
+ has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True
+ has_labelled_fields (ConDeclH98 { con_args = RecCon rec })
+ = not (null (unLoc rec))
+ has_labelled_fields _ = False
+
+ has_strictness_flags condecl
+ = any (is_strict . getBangStrictness . hsScaledThing) (con_args condecl)
+
+ is_strict (HsSrcBang _ _ s) = isSrcStrict s
+
+ con_args (ConDeclGADT { con_g_args = PrefixConGADT args }) = args
+ con_args (ConDeclH98 { con_args = PrefixCon _ args }) = args
+ con_args (ConDeclH98 { con_args = InfixCon arg1 arg2 }) = [arg1, arg2]
+ con_args _ = []
+
+{-
+Note [Type data declarations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+With the TypeData extension (GHC proposal #106), one can write "type data"
+declarations, like
+
+ type data Nat = Zero | Succ Nat
+
+or equivalently in GADT style:
+
+ type data Nat where
+ Zero :: Nat
+ Succ :: Nat -> Nat
+
+This defines the constructors Zero and Succ in the TcCls namespace
+(type constructors and classes) instead of the Data namespace (data
+constructors). This contrasts with the DataKinds extension, which allows
+constructors defined in the Data namespace to be promoted to the TcCls
+namespace at the point of use in a type.
+
+Type data declarations have the syntax of data declarations, either
+ordinary algebraic data types or GADTs, preceded by "type", with the
+following restrictions:
+
+(R1) There are data type contexts (even with the DatatypeContexts extension).
+
+(R2) There are no labelled fields. Perhaps these could be supported
+ using type families, but they are omitted for now.
+
+(R3) There are no strictness flags, because they don't make sense at
+ the type level.
+
+(R4) The types of the constructors contain no constraints other than
+ equality constraints. (This is the same restriction imposed
+ on constructors to be promoted with the DataKinds extension in
+ dc_theta_illegal_constraint called from GHC.Tc.Gen.HsType.tcTyVar,
+ but in that case the restriction is imposed if and when a data
+ constructor is used in a type, whereas here it is imposed at
+ the point of definition. See also Note [Constraints in kinds]
+ in GHC.Core.TyCo.Rep.)
+
+(R5) There are no deriving clauses.
+
+The main parts of the implementation are:
+
+* The Bool argument to DataTypeCons (in Language.Haskell.Syntax.Decls)
+ distinguishes "type data" declarations from ordinary "data" declarations.
+
+* This flag is set, and the constructor names placed in the
+ TcCls namespace, during the initial construction of the AST in
+ GHC.Parser.PostProcess.checkNewOrData.
+
+* GHC.Rename.Module.rnDataDefn calls check_type_data on these
+ declarations, which checks that the TypeData extension is enabled and
+ checks restrictions (R1), (R2), (R3) and (R5). They could equally
+ well be checked in the typechecker, but we err on the side of catching
+ imposters early.
+
+* GHC.Tc.TyCl.checkValidDataCon checks restriction (R4) on these declarations.
+
+* When beginning to type check a mutually recursive group of declarations,
+ the "type data" constructors are added to the type-checker environment
+ as APromotionErr TyConPE by GHC.Tc.TyCl.mkPromotionErrorEnv, so they
+ cannot be used within the recursive group. This mirrors the DataKinds
+ behaviour described at Note [Recursion and promoting data constructors]
+ in GHC.Tc.TyCl. For example, this is rejected:
+
+ type data T f = K (f (K Int))
+
+* After a "type data" declaration has been type-checked, the type-checker
+ environment entry for each constructor (which can be recognized
+ by being in the TcCls namespace) is just the promoted type
+ constructor, not the bundle required for a data constructor.
+ (GHC.Types.TyThing.implicitTyConThings)
+
+-}
+
warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
-> SrcSpan
-> RnM ()
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index e4f11fa3fd..edc0af5f52 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -2198,9 +2198,13 @@ packageImportErr
-- We can get an operator as the constructor, even in the prefix form:
-- data T = :% Int Int
-- from interface files, which always print in prefix form
+--
+-- We also allow type constructor names, which are defined by "type data"
+-- declarations. See Note [Type data declarations] in GHC.Rename.Module.
checkConName :: RdrName -> TcRn ()
-checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
+checkConName name
+ = checkErr (isRdrDataCon name || isRdrTc name) (badDataCon name)
badDataCon :: RdrName -> TcRnMessage
badDataCon name
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index ab338cf452..3f6989e9f9 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -994,6 +994,13 @@ instance Diagnostic TcRnMessage where
text "No explicit" <+> text "associated type"
<+> text "or default declaration for"
<+> quotes (ppr name)
+ TcRnIllegalTypeData
+ -> mkSimpleDecorated $
+ text "Illegal type-level data declaration"
+ TcRnTypeDataForbids feature
+ -> mkSimpleDecorated $
+ ppr feature <+> text "are not allowed in type data declarations."
+
diagnosticReason = \case
TcRnUnknownMessage m
-> diagnosticReason m
@@ -1323,6 +1330,10 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
-> WarningWithFlag (Opt_WarnMissingMethods)
+ TcRnIllegalTypeData
+ -> ErrorWithoutFlag
+ TcRnTypeDataForbids{}
+ -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -1655,6 +1666,10 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
-> noHints
+ TcRnIllegalTypeData
+ -> [suggestExtension LangExt.TypeData]
+ TcRnTypeDataForbids{}
+ -> noHints
diagnosticCode = constructorCode
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 16d91f1c44..a2daa7d900 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -7,6 +7,7 @@ module GHC.Tc.Errors.Types (
TcRnMessage(..)
, mkTcRnUnknownMessage
, TcRnMessageDetailed(..)
+ , TypeDataForbids(..)
, ErrInfo(..)
, FixedRuntimeRepProvenance(..)
, pprFixedRuntimeRepProvenance
@@ -2288,8 +2289,48 @@ data TcRnMessage where
:: Name
-> TcRnMessage
+ {-| TcRnIllegalTypeData is an error that occurs when a @type data@
+ declaration occurs without the TypeOperators extension.
+
+ See Note [Type data declarations]
+
+ Test case:
+ testsuite/tests/type-data/should_fail/TDNoPragma
+ -}
+ TcRnIllegalTypeData :: TcRnMessage
+
+ {-| TcRnTypeDataForbids is an error that occurs when a @type data@
+ declaration contains @data@ declaration features that are
+ forbidden in a @type data@ declaration.
+
+ See Note [Type data declarations]
+
+ Test cases:
+ testsuite/tests/type-data/should_fail/TDDeriving
+ testsuite/tests/type-data/should_fail/TDRecordsGADT
+ testsuite/tests/type-data/should_fail/TDRecordsH98
+ testsuite/tests/type-data/should_fail/TDStrictnessGADT
+ testsuite/tests/type-data/should_fail/TDStrictnessH98
+ -}
+ TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage
+
deriving Generic
+-- | Things forbidden in @type data@ declarations.
+-- See Note [Type data declarations]
+data TypeDataForbids
+ = TypeDataForbidsDatatypeContexts
+ | TypeDataForbidsLabelledFields
+ | TypeDataForbidsStrictnessAnnotations
+ | TypeDataForbidsDerivingClauses
+ deriving Generic
+
+instance Outputable TypeDataForbids where
+ ppr TypeDataForbidsDatatypeContexts = text "Data type contexts"
+ ppr TypeDataForbidsLabelledFields = text "Labelled fields"
+ ppr TypeDataForbidsStrictnessAnnotations = text "Strictness flags"
+ ppr TypeDataForbidsDerivingClauses = text "Deriving clauses"
+
-- | Specifies which back ends can handle a requested foreign import or export
type ExpectedBackends = [Backend]
-- | Specifies which calling convention is unsupported on the current platform
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index d0eb6337ef..3539b6e0e5 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -1287,9 +1287,15 @@ mk_prom_err_env (DataDecl { tcdLName = L _ name
, tcdDataDefn = HsDataDefn { dd_cons = cons } })
= unitNameEnv name (APromotionErr TyConPE)
`plusNameEnv`
- mkNameEnv [ (con, APromotionErr RecDataConPE)
+ mkNameEnv [ (con, APromotionErr conPE)
| L _ con' <- toList cons
, L _ con <- getConNames con' ]
+ where
+ -- In a "type data" declaration, the constructors are at the type level.
+ -- See Note [Type data declarations] in GHC.Rename.Module.
+ conPE
+ | isTypeDataDefnCons cons = TyConPE
+ | otherwise = RecDataConPE
mk_prom_err_env decl
= unitNameEnv (tcdName decl) (APromotionErr TyConPE)
@@ -1788,6 +1794,9 @@ mappings:
APromotionErr is only used for DataCons, and only used during type checking
in tcTyClGroup.
+The same restriction applies constructors in to "type data" declarations.
+See Note [Type data declarations] in GHC.Rename.Module.
+
************************************************************************
* *
@@ -2952,17 +2961,17 @@ tcDataDefn err_ctxt roles_info tc_name
-- so one could not have, say, a data family instance in an hsig file that
-- has kind `Bool`. Therefore, this check need only occur in the code that
-- typechecks data type declarations.
- mk_permissive_kind HsigFile (DataTypeCons []) = True
+ mk_permissive_kind HsigFile (DataTypeCons _ []) = True
mk_permissive_kind _ _ = False
-- In an hs-boot or a signature file,
-- a 'data' declaration with no constructors
-- indicates a nominally distinct abstract data type.
- mk_tc_rhs (isHsBootOrSig -> True) _ (DataTypeCons [])
+ mk_tc_rhs (isHsBootOrSig -> True) _ (DataTypeCons _ [])
= return AbstractTyCon
mk_tc_rhs _ tycon data_cons = case data_cons of
- DataTypeCons data_cons -> return $
+ DataTypeCons _ data_cons -> return $
mkLevPolyDataTyConRhs
(isFixedRuntimeRepKind (tyConResKind tycon))
data_cons
@@ -3367,7 +3376,7 @@ concatMapDataDefnConsTcM name f = \ case
NewTypeCon a -> f NewType a >>= \ case
b:|[] -> pure (NewTypeCon b)
bs -> failWithTc $ newtypeConError name (length bs)
- DataTypeCons as -> DataTypeCons <$> concatMapM (fmap toList . f DataType) as
+ DataTypeCons is_type_data as -> DataTypeCons is_type_data <$> concatMapM (fmap toList . f DataType) as
tcConDecl :: NewOrData
-> DataDeclInfo
@@ -4415,6 +4424,14 @@ checkValidDataCon dflags existential_ok tc con
; checkTc (existential_ok || isVanillaDataCon con)
(badExistential con)
+ -- Check that the only constraints in signatures of constructors
+ -- in a "type data" declaration are equality constraints.
+ -- See Note [Type data declarations] in GHC.Rename.Module,
+ -- restriction (R4).
+ ; when (isTypeDataCon con) $
+ checkTc (all isEqPred (dataConOtherTheta con))
+ (TcRnConstraintInKind (dataConRepType con))
+
-- Check that UNPACK pragmas and bangs work out
-- E.g. reject data T = MkT {-# UNPACK #-} Int -- No "!"
-- data T = MkT {-# UNPACK #-} !a -- Can't unpack
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 32d710dec7..e1b7fc0f0f 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -772,7 +772,7 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env
; rep_tc_name <- newFamInstTyConName lfam_name pats
; axiom_name <- newFamInstAxiomName lfam_name [pats]
; tc_rhs <- case data_cons of
- DataTypeCons data_cons -> return $
+ DataTypeCons _ data_cons -> return $
mkLevPolyDataTyConRhs
(isFixedRuntimeRepKind res_kind)
data_cons
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index f7ba81db6b..47e8b5758c 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -294,7 +294,8 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = DataTypeCons cons', dd_derivs = derivs' }
+ , dd_cons = DataTypeCons False cons'
+ , dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
DataDecl { tcdDExt = noAnn
, tcdLName = tc', tcdTyVars = tvs'
@@ -381,7 +382,8 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = DataTypeCons cons', dd_derivs = derivs' }
+ , dd_cons = DataTypeCons False cons'
+ , dd_derivs = derivs' }
; returnJustLA $ InstD noExtField $ DataFamInstD
{ dfid_ext = noExtField
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index 639863c630..58353483dc 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -466,6 +466,8 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIgnoreSpecialisePragmaOnDefMethod" = 72520
GhcDiagnosticCode "TcRnBadMethodErr" = 46284
GhcDiagnosticCode "TcRnNoExplicitAssocTypeOrDefaultDeclaration" = 08585
+ GhcDiagnosticCode "TcRnIllegalTypeData" = 15013
+ GhcDiagnosticCode "TcRnTypeDataForbids" = 67297
-- TcRnPragmaWarning
GhcDiagnosticCode "WarningTxt" = 63394
diff --git a/compiler/GHC/Types/TyThing.hs b/compiler/GHC/Types/TyThing.hs
index 8a12506a63..628d8da801 100644
--- a/compiler/GHC/Types/TyThing.hs
+++ b/compiler/GHC/Types/TyThing.hs
@@ -183,9 +183,8 @@ implicitTyConThings tc
implicitCoTyCon tc ++
-- for each data constructor in order,
- -- the constructor, worker, and (possibly) wrapper
- [ thing | dc <- tyConDataCons tc
- , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]
+ -- the constructor and associated implicit 'Id's
+ concatMap datacon_stuff (tyConDataCons tc)
-- NB. record selectors are *not* implicit, they have fully-fledged
-- bindings that pass through the compilation pipeline as normal.
where
@@ -193,6 +192,17 @@ implicitTyConThings tc
Nothing -> []
Just cl -> implicitClassThings cl
+ -- For each data constructor,
+ -- the constructor, worker, and (possibly) wrapper
+ --
+ -- If the data constructor is in a "type data" declaration,
+ -- promote it to the type level now.
+ -- See Note [Type data declarations] in GHC.Rename.Module.
+ datacon_stuff dc
+ | isTypeDataCon dc = [ATyCon (promoteDataCon dc)]
+ | otherwise
+ = AConLike (RealDataCon dc) : dataConImplicitTyThings dc
+
-- For newtypes and closed type families (only) add the implicit coercion tycon
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon tc
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index e7c23f84cf..af8c0bb1e9 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -16,7 +16,7 @@
{-
(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+(c) The GRASP/@type@AQUA Project, Glasgow University, 1992-1998
-}
@@ -33,6 +33,7 @@ module Language.Haskell.Syntax.Decls (
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..),
HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData,
+ isTypeDataDefnCons,
StandaloneKindSig(..), LStandaloneKindSig,
-- ** Class or type declarations
@@ -991,16 +992,28 @@ data NewOrData
| DataType -- ^ @data Blah ...@
deriving ( Eq, Data ) -- Needed because Demand derives Eq
--- | Whether a data-type declaration is `data` or `newtype`, and its constructors
+-- | Whether a data-type declaration is @data@ or @newtype@, and its constructors.
data DataDefnCons a
- = NewTypeCon a -- ^ @newtype Blah ...@
- | DataTypeCons [a] -- ^ @data Blah ...@
+ = NewTypeCon -- @newtype N x = MkN blah@
+ a -- Info about the single data constructor @MkN@
+
+ | DataTypeCons
+ Bool -- True <=> type data T x = ...
+ -- See Note [Type data declarations] in GHC.Rename.Module
+ -- False <=> data T x = ...
+ [a] -- The (possibly empty) list of data constructors
deriving ( Eq, Data, Foldable, Functor, Traversable ) -- Needed because Demand derives Eq
dataDefnConsNewOrData :: DataDefnCons a -> NewOrData
dataDefnConsNewOrData = \ case
NewTypeCon _ -> NewType
- DataTypeCons _ -> DataType
+ DataTypeCons _ _ -> DataType
+
+-- | Are the constructors within a @type data@ declaration?
+-- See Note [Type data declarations] in GHC.Rename.Module.
+isTypeDataDefnCons :: DataDefnCons a -> Bool
+isTypeDataDefnCons (NewTypeCon _) = False
+isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data
-- | Located data Constructor Declaration
type LConDecl pass = XRec pass (ConDecl pass)
diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst
index 355fc63838..f66ba9e06a 100644
--- a/docs/users_guide/9.6.1-notes.rst
+++ b/docs/users_guide/9.6.1-notes.rst
@@ -62,6 +62,12 @@ Language
- Error messages are now assigned unique error codes, of the form ``[GHC-12345]``.
+- GHC Proposal `#106
+ <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0106-type-data.rst>`_
+ has been implemented, introducing a new language extension
+ :extension:`TypeData`. This extension permits ``type data`` declarations
+ as a more fine-grained alternative to :extension:`DataKinds`.
+
Compiler
~~~~~~~~
diff --git a/docs/users_guide/exts/data_kinds.rst b/docs/users_guide/exts/data_kinds.rst
index 50816cbb53..bf99065907 100644
--- a/docs/users_guide/exts/data_kinds.rst
+++ b/docs/users_guide/exts/data_kinds.rst
@@ -15,6 +15,7 @@ system that complements kind polymorphism. It is enabled by
:extension:`DataKinds`, and described in more detail in the paper `Giving
Haskell a Promotion <https://dreixel.net/research/pdf/ghp.pdf>`__, which
appeared at TLDI 2012.
+See also :extension:`TypeData` for a more fine-grained alternative.
Motivation
----------
diff --git a/docs/users_guide/exts/type_data.rst b/docs/users_guide/exts/type_data.rst
new file mode 100644
index 0000000000..0779b23273
--- /dev/null
+++ b/docs/users_guide/exts/type_data.rst
@@ -0,0 +1,60 @@
+Type-level data declarations
+============================
+
+.. extension:: TypeData
+ :shortdesc: Enable type data declarations.
+
+ :since: 9.6.1
+
+ Allow ``type data`` declarations, which define constructors at the type level.
+
+This extension facilitates type-level (compile-time) programming by
+allowing a type-level counterpart of ``data`` declarations, such as this
+definition of type-level natural numbers: ::
+
+ type data Nat = Zero | Succ Nat
+
+This is similar to the corresponding ``data`` declaration, except that
+the constructors ``Zero`` and ``Succ`` it introduces belong to the type
+constructor namespace, so they can be used in types, such as the type
+of length-indexed vectors: ::
+
+ data Vec :: Type -> Nat -> Type where
+ Nil :: Vec a Zero
+ Cons :: a -> Vec a n -> Vec a (Succ n)
+
+:extension:`TypeData` is a more fine-grained alternative to the
+:extension:`DataKinds` extension, which defines *all* the constructors
+in *all* ``data`` declarations as both data constructors and type
+constructors.
+
+A ``type data`` declaration has the same syntax as a ``data`` declaration,
+either an ordinary algebraic data type or a GADT, prefixed with the keyword
+``type``, except that it may not contain
+a datatype context (even with :extension:`DatatypeContexts`),
+labelled fields,
+strictness flags, or
+a ``deriving`` clause.
+
+The only constraints permitted in the types of constructors are
+equality constraints, e.g.: ::
+
+ type data P :: Type -> Type -> Type where
+ MkP :: (a ~ Natural, b ~~ Char) => P a b
+
+Because ``type data`` declarations introduce type constructors, they do
+not permit constructors with the same names as types, so the following
+declaration is invalid: ::
+
+ type data T = T // Invalid
+
+The compiler will reject this declaration, because the type constructor
+``T`` is defined twice (as the datatype being defined and as a type
+constructor).
+
+The main type constructor of a ``type data`` declaration can be defined
+recursively, as in the ``Nat`` example above, but its constructors may not
+be used in types within the same mutually recursive group of declarations,
+so the following is forbidden: ::
+
+ type data T f = K (f (K Int)) // Invalid
diff --git a/docs/users_guide/exts/types.rst b/docs/users_guide/exts/types.rst
index 23f0c118ab..ea85223184 100644
--- a/docs/users_guide/exts/types.rst
+++ b/docs/users_guide/exts/types.rst
@@ -16,6 +16,7 @@ Types
gadt
type_families
data_kinds
+ type_data
poly_kinds
representation_polymorphism
type_literals
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject dac10555299fa0d750838529a67598821264e5e
+Subproject 410f871df899e5af0847089354e0031fe051551
diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
index 0fd00b2c40..e0a1d7a2a5 100644
--- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
+++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
@@ -73,6 +73,7 @@ data Extension
| ConstraintKinds
| PolyKinds -- Kind polymorphism
| DataKinds -- Datatype promotion
+ | TypeData -- allow @type data@ definitions
| InstanceSigs
| ApplicativeDo
| LinearTypes
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs
index c25c3b7f1c..d8cf02218c 100644
--- a/testsuite/tests/driver/T4437.hs
+++ b/testsuite/tests/driver/T4437.hs
@@ -38,6 +38,7 @@ check title expected got
expectedGhcOnlyExtensions :: [String]
expectedGhcOnlyExtensions =
[ "DeepSubsumption"
+ , "TypeData"
]
expectedCabalOnlyExtensions :: [String]
diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
index 60ff0ec324..2bac5ab532 100644
--- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr
+++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
@@ -111,6 +111,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnn
(Anchor
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index de2f98d899..257d03eb20 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -840,6 +840,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-18 })
(ConDeclGADT
@@ -1108,6 +1109,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-18 })
(ConDeclGADT
@@ -1376,6 +1378,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-18 })
(ConDeclGADT
@@ -1644,6 +1647,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-18 })
(ConDeclGADT
@@ -1912,6 +1916,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-18 })
(ConDeclGADT
@@ -2180,6 +2185,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-20 })
(ConDeclGADT
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index e00ee8798a..efc2c927ae 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -83,6 +83,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-20 })
(ConDeclGADT
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 926d97fb35..fdea6a5bce 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -98,6 +98,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnn
(Anchor
@@ -536,6 +537,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:21-29 })
(ConDeclH98
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 88f23d3ee0..d3b7566f5d 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -113,6 +113,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnn
(Anchor
@@ -788,6 +789,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:21-29 })
(ConDeclH98
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index 29225d7f00..caede8b720 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -39,6 +39,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnn
(Anchor
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index fbcfa63276..36768671e4 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -85,6 +85,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-54 })
(ConDeclGADT
diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr
index c7808c1019..8cbc6e13c2 100644
--- a/testsuite/tests/parser/should_compile/T20452.stderr
+++ b/testsuite/tests/parser/should_compile/T20452.stderr
@@ -102,6 +102,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:26-31 })
(ConDeclH98
@@ -191,6 +192,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:26-31 })
(ConDeclH98
diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index 2d8d3060ab..52c97faba4 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -71,6 +71,7 @@
(Nothing)
(Nothing)
(DataTypeCons
+ (False)
[(L
(SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-17 })
(ConDeclGADT
diff --git a/testsuite/tests/type-data/Makefile b/testsuite/tests/type-data/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/type-data/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/type-data/should_compile/Makefile b/testsuite/tests/type-data/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/type-data/should_compile/TDDataConstructor.hs b/testsuite/tests/type-data/should_compile/TDDataConstructor.hs
new file mode 100644
index 0000000000..8474ec25eb
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/TDDataConstructor.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+module TDDataConstructor where
+
+type data P = MkP
+data Prom = P
diff --git a/testsuite/tests/type-data/should_compile/TDExistential.hs b/testsuite/tests/type-data/should_compile/TDExistential.hs
new file mode 100644
index 0000000000..0e9bb04014
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/TDExistential.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE TypeFamilies #-}
+module TDExistential where
+
+import Data.Kind (Type)
+
+-- example from GHC User's Guide 6.4.10.6
+
+type data Ex :: Type where
+ MkEx :: forall a. a -> Ex
+
+type family UnEx (ex :: Ex) :: k
+type instance UnEx (MkEx x) = x
diff --git a/testsuite/tests/type-data/should_compile/TDGoodConsConstraints.hs b/testsuite/tests/type-data/should_compile/TDGoodConsConstraints.hs
new file mode 100644
index 0000000000..0b4e006184
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/TDGoodConsConstraints.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE GADTs #-}
+module TDGoodConsConstraints where
+
+import Data.Kind (Type)
+import Data.Type.Equality
+
+type data Foo :: Type -> Type where
+ MkFoo1 :: a ~ Int => Foo a
+ MkFoo2 :: a ~~ Int => Foo a
diff --git a/testsuite/tests/type-data/should_compile/TDVector.hs b/testsuite/tests/type-data/should_compile/TDVector.hs
new file mode 100644
index 0000000000..753cd97375
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/TDVector.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE MonoLocalBinds #-}
+module TDVector where
+
+import Data.Kind (Type)
+
+type data Nat = Zero | Succ Nat
+
+type data List a = Nil | Cons a (List a)
+
+type data Pair a b = MkPair a b
+
+type data Sum a b = L a | R b
+
+data Vec :: Nat -> Type -> Type where
+ VNil :: Vec Zero a
+ VCons :: a -> Vec n a -> Vec (Succ n) a
+
+instance Functor (Vec n) where
+ fmap _ VNil = VNil
+ fmap f (VCons x xs) = VCons (f x) (fmap f xs)
diff --git a/testsuite/tests/type-data/should_compile/all.T b/testsuite/tests/type-data/should_compile/all.T
new file mode 100644
index 0000000000..0f8294bee7
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/all.T
@@ -0,0 +1,4 @@
+test('TDDataConstructor', normal, compile, [''])
+test('TDExistential', normal, compile, [''])
+test('TDGoodConsConstraints', normal, compile, [''])
+test('TDVector', normal, compile, [''])
diff --git a/testsuite/tests/type-data/should_fail/Makefile b/testsuite/tests/type-data/should_fail/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/type-data/should_fail/TDBadConsConstraint.hs b/testsuite/tests/type-data/should_fail/TDBadConsConstraint.hs
new file mode 100644
index 0000000000..43a709f516
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDBadConsConstraint.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE GADTs #-}
+module TDConsConstraints where
+
+import Data.Kind (Type)
+
+type data Foo :: Type -> Type where
+ MkFoo3 :: Show a => Foo a
diff --git a/testsuite/tests/type-data/should_fail/TDBadConsConstraint.stderr b/testsuite/tests/type-data/should_fail/TDBadConsConstraint.stderr
new file mode 100644
index 0000000000..1e2eddc456
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDBadConsConstraint.stderr
@@ -0,0 +1,5 @@
+
+TDBadConsConstraint.hs:8:3: [GHC-01259]
+ Illegal constraint in a kind: forall a. Show a => Foo a
+ In the definition of data constructor ‘MkFoo3’
+ In the data type declaration for ‘Foo’
diff --git a/testsuite/tests/type-data/should_fail/TDDeriving.hs b/testsuite/tests/type-data/should_fail/TDDeriving.hs
new file mode 100644
index 0000000000..dc804fc532
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDDeriving.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+module TDDeriving where
+
+type data Nat = Zero | Succ Nat
+ deriving (Eq)
diff --git a/testsuite/tests/type-data/should_fail/TDDeriving.stderr b/testsuite/tests/type-data/should_fail/TDDeriving.stderr
new file mode 100644
index 0000000000..231f2c7df7
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDDeriving.stderr
@@ -0,0 +1,3 @@
+
+TDDeriving.hs:4:1: [GHC-67297]
+ Deriving clauses are not allowed in type data declarations.
diff --git a/testsuite/tests/type-data/should_fail/TDExpression.hs b/testsuite/tests/type-data/should_fail/TDExpression.hs
new file mode 100644
index 0000000000..4f04993459
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDExpression.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeData #-}
+module TDExpression where
+
+type data Nat = Zero | Succ Nat
+
+-- Not in scope: data constructor ‘Zero’
+z = Zero
diff --git a/testsuite/tests/type-data/should_fail/TDExpression.stderr b/testsuite/tests/type-data/should_fail/TDExpression.stderr
new file mode 100644
index 0000000000..354dac183f
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDExpression.stderr
@@ -0,0 +1,6 @@
+
+TDExpression.hs:7:5: [GHC-31891]
+ Illegal term-level use of the type constructor or class ‘Zero’
+ defined at TDExpression.hs:4:17
+ In the expression: Zero
+ In an equation for ‘z’: z = Zero
diff --git a/testsuite/tests/type-data/should_fail/TDMultiple01.hs b/testsuite/tests/type-data/should_fail/TDMultiple01.hs
new file mode 100644
index 0000000000..ead94c4d1d
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDMultiple01.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+module TDMultiple01 where
+
+data P = MkP
+type data Prom = P -- P is multiply defined
diff --git a/testsuite/tests/type-data/should_fail/TDMultiple01.stderr b/testsuite/tests/type-data/should_fail/TDMultiple01.stderr
new file mode 100644
index 0000000000..5b3abe33ed
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDMultiple01.stderr
@@ -0,0 +1,5 @@
+
+TDMultiple01.hs:5:18:
+ Multiple declarations of ‘P’
+ Declared at: TDMultiple01.hs:4:1
+ TDMultiple01.hs:5:18
diff --git a/testsuite/tests/type-data/should_fail/TDMultiple02.hs b/testsuite/tests/type-data/should_fail/TDMultiple02.hs
new file mode 100644
index 0000000000..91dcf565f7
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDMultiple02.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+module TDMultiple02 where
+
+type data P = MkP
+type data Prom = P -- type P is multiply defined
diff --git a/testsuite/tests/type-data/should_fail/TDMultiple02.stderr b/testsuite/tests/type-data/should_fail/TDMultiple02.stderr
new file mode 100644
index 0000000000..c08709fa8c
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDMultiple02.stderr
@@ -0,0 +1,5 @@
+
+TDMultiple02.hs:5:18:
+ Multiple declarations of ‘P’
+ Declared at: TDMultiple02.hs:4:1
+ TDMultiple02.hs:5:18
diff --git a/testsuite/tests/type-data/should_fail/TDNoPragma.hs b/testsuite/tests/type-data/should_fail/TDNoPragma.hs
new file mode 100644
index 0000000000..a1b5386f62
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDNoPragma.hs
@@ -0,0 +1,4 @@
+module TDNoPragma where
+
+-- requires LANGUAGE TypeData
+type data Nat = Zero | Succ Nat
diff --git a/testsuite/tests/type-data/should_fail/TDNoPragma.stderr b/testsuite/tests/type-data/should_fail/TDNoPragma.stderr
new file mode 100644
index 0000000000..62b47da4d1
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDNoPragma.stderr
@@ -0,0 +1,4 @@
+
+TDNoPragma.hs:4:1: [GHC-15013]
+ Illegal type-level data declaration
+ Suggested fix: Perhaps you intended to use TypeData
diff --git a/testsuite/tests/type-data/should_fail/TDPattern.hs b/testsuite/tests/type-data/should_fail/TDPattern.hs
new file mode 100644
index 0000000000..abcf65de24
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDPattern.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeData #-}
+module TDPattern where
+
+type data Nat = Zero | Succ Nat
+
+-- Zero is not a data constructor
+f Zero = 0
diff --git a/testsuite/tests/type-data/should_fail/TDPattern.stderr b/testsuite/tests/type-data/should_fail/TDPattern.stderr
new file mode 100644
index 0000000000..3fecbb1f6b
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDPattern.stderr
@@ -0,0 +1,3 @@
+
+TDPattern.hs:7:3: [GHC-76037]
+ Not in scope: data constructor ‘Zero’
diff --git a/testsuite/tests/type-data/should_fail/TDPunning.hs b/testsuite/tests/type-data/should_fail/TDPunning.hs
new file mode 100644
index 0000000000..0560009ce8
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDPunning.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeData #-}
+module TDPunning where
+
+type data T = T -- type T is multiply defined
diff --git a/testsuite/tests/type-data/should_fail/TDPunning.stderr b/testsuite/tests/type-data/should_fail/TDPunning.stderr
new file mode 100644
index 0000000000..95ddbf51d3
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDPunning.stderr
@@ -0,0 +1,5 @@
+
+TDPunning.hs:4:15:
+ Multiple declarations of ‘T’
+ Declared at: TDPunning.hs:4:1
+ TDPunning.hs:4:15
diff --git a/testsuite/tests/type-data/should_fail/TDRecordsGADT.hs b/testsuite/tests/type-data/should_fail/TDRecordsGADT.hs
new file mode 100644
index 0000000000..0d9e6536c3
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecordsGADT.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE GADTs #-}
+module TDRecordsGADT where
+
+type data Record a where
+ Cons :: { field :: a } -> Record a
diff --git a/testsuite/tests/type-data/should_fail/TDRecordsGADT.stderr b/testsuite/tests/type-data/should_fail/TDRecordsGADT.stderr
new file mode 100644
index 0000000000..8695163190
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecordsGADT.stderr
@@ -0,0 +1,3 @@
+
+TDRecordsGADT.hs:6:5: [GHC-67297]
+ Labelled fields are not allowed in type data declarations.
diff --git a/testsuite/tests/type-data/should_fail/TDRecordsH98.hs b/testsuite/tests/type-data/should_fail/TDRecordsH98.hs
new file mode 100644
index 0000000000..d6d805532f
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecordsH98.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeData #-}
+module TDRecordsH98 where
+
+type data Record a = Cons { field :: a }
diff --git a/testsuite/tests/type-data/should_fail/TDRecordsH98.stderr b/testsuite/tests/type-data/should_fail/TDRecordsH98.stderr
new file mode 100644
index 0000000000..c20a83dc73
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecordsH98.stderr
@@ -0,0 +1,3 @@
+
+TDRecordsH98.hs:4:22: [GHC-67297]
+ Labelled fields are not allowed in type data declarations.
diff --git a/testsuite/tests/type-data/should_fail/TDRecursive.hs b/testsuite/tests/type-data/should_fail/TDRecursive.hs
new file mode 100644
index 0000000000..b4a09c165e
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecursive.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeData #-}
+module TDRecursive where
+
+type data T f = K (f (K Int))
diff --git a/testsuite/tests/type-data/should_fail/TDRecursive.stderr b/testsuite/tests/type-data/should_fail/TDRecursive.stderr
new file mode 100644
index 0000000000..8225bd1790
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDRecursive.stderr
@@ -0,0 +1,7 @@
+
+TDRecursive.hs:4:23: [GHC-88634]
+ Type constructor ‘K’ cannot be used here
+ (it is defined and used in the same recursive group)
+ In the first argument of ‘f’, namely ‘(K Int)’
+ In the type ‘(f (K Int))’
+ In the definition of data constructor ‘K’
diff --git a/testsuite/tests/type-data/should_fail/TDStrictnessGADT.hs b/testsuite/tests/type-data/should_fail/TDStrictnessGADT.hs
new file mode 100644
index 0000000000..774c560e30
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDStrictnessGADT.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+module TDStrictnessGADT where
+
+type data T a where
+ Cons :: !a -> T a
diff --git a/testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr b/testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr
new file mode 100644
index 0000000000..db235cd048
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr
@@ -0,0 +1,3 @@
+
+TDStrictnessGADT.hs:5:6: [GHC-67297]
+ Strictness flags are not allowed in type data declarations.
diff --git a/testsuite/tests/type-data/should_fail/TDStrictnessH98.hs b/testsuite/tests/type-data/should_fail/TDStrictnessH98.hs
new file mode 100644
index 0000000000..062df5bd02
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDStrictnessH98.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeData #-}
+module TDStrictnessH98 where
+
+type data T a = Cons !a
diff --git a/testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr b/testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr
new file mode 100644
index 0000000000..e0ccd5e456
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr
@@ -0,0 +1,3 @@
+
+TDStrictnessH98.hs:4:17: [GHC-67297]
+ Strictness flags are not allowed in type data declarations.
diff --git a/testsuite/tests/type-data/should_fail/all.T b/testsuite/tests/type-data/should_fail/all.T
new file mode 100644
index 0000000000..ddf7bd86bd
--- /dev/null
+++ b/testsuite/tests/type-data/should_fail/all.T
@@ -0,0 +1,13 @@
+test('TDNoPragma', normal, compile_fail, [''])
+test('TDBadConsConstraint', normal, compile_fail, [''])
+test('TDDeriving', normal, compile_fail, [''])
+test('TDExpression', normal, compile_fail, [''])
+test('TDMultiple01', normal, compile_fail, [''])
+test('TDMultiple02', normal, compile_fail, [''])
+test('TDPattern', normal, compile_fail, [''])
+test('TDPunning', normal, compile_fail, [''])
+test('TDRecordsGADT', normal, compile_fail, [''])
+test('TDRecordsH98', normal, compile_fail, [''])
+test('TDRecursive', normal, compile_fail, [''])
+test('TDStrictnessGADT', normal, compile_fail, [''])
+test('TDStrictnessH98', normal, compile_fail, [''])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 277fcfcd3a..25ea557a27 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -2748,7 +2748,7 @@ exactDataDefn an exactHdr
, dd_cons = condecls, dd_derivs = derivings }) = do
annotationsToComments (epAnnAnns an) [AnnOpenP, AnnCloseP]
markEpAnn an $ case condecls of
- DataTypeCons _ -> AnnData
+ DataTypeCons _ _ -> AnnData
NewTypeCon _ -> AnnNewtype
markEpAnn an AnnInstance -- optional
mapM_ markAnnotated mb_ct
diff --git a/utils/haddock b/utils/haddock
-Subproject f114ba7fc0751f53766e2c3089e234927237a98
+Subproject e5b41a9f92de608f3605ef54da5709074e189ad