diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 99a6ff364cee40373f28f40aba011a0bc1996594..7e9f93dceffe369902cf8153b0717aa84898d10f 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -41,6 +41,7 @@ import TcUnify import CoreSyn ( Expr(..), mkApps, mkVarApps, mkLams ) import MkCore ( nO_METHOD_BINDING_ERROR_ID ) import CoreUnfold ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) +import Kind import Type import TcEvidence import TyCon @@ -680,7 +681,7 @@ tcDataFamInstDecl mb_clsinfo -- Deal with any kind signature. -- See also Note [Arity of data families] in FamInstEnv ; (extra_tcbs, final_res_kind) <- tcDataKindSig full_tcbs res_kind' - ; checkTc (isLiftedTypeKind final_res_kind) (badKindSig True res_kind') + ; checkTc (tcIsStarKind final_res_kind) (badKindSig True res_kind') ; let extra_pats = map (mkTyVarTy . binderVar) extra_tcbs all_pats = pats' `chkAppend` extra_pats @@ -722,7 +723,7 @@ tcDataFamInstDecl mb_clsinfo ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' extra_pats pp_hs_pats -- Result kind must be '*' (otherwise, we have too few patterns) - ; checkTc (isLiftedTypeKind final_res_kind) $ + ; checkTc (tcIsStarKind final_res_kind) $ tooFewParmsErr (tyConArity fam_tc) ; checkValidTyCon rep_tc diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 926190558556f7694df43acd952b736c526927fe..89ec2950a41e6809200794a8b8fba91351de4458 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -882,7 +882,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na -- Data families might have a variable return kind. -- See See Note [Arity of data families] in FamInstEnv. ; (extra_binders, final_res_kind) <- tcDataKindSig binders res_kind - ; checkTc (isLiftedTypeKind final_res_kind + ; checkTc (tcIsStarKind final_res_kind || isJust (tcGetCastedTyVar_maybe final_res_kind)) (badKindSig False res_kind) @@ -1034,7 +1034,7 @@ tcDataDefn roles_info ; let hsc_src = tcg_src tcg_env ; (extra_bndrs, final_res_kind) <- tcDataKindSig tycon_binders res_kind ; unless (mk_permissive_kind hsc_src cons) $ - checkTc (isLiftedTypeKind final_res_kind) (badKindSig True res_kind) + checkTc (tcIsStarKind final_res_kind) (badKindSig True res_kind) ; let final_bndrs = tycon_binders `chkAppend` extra_bndrs roles = roles_info tc_name diff --git a/testsuite/tests/typecheck/should_fail/T14048a.hs b/testsuite/tests/typecheck/should_fail/T14048a.hs new file mode 100644 index 0000000000000000000000000000000000000000..c717127df8d1ed08ccea78f788e0e1b506e398da --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ConstraintKinds #-} +module T14048a where + +import Data.Kind + +data Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048a.stderr b/testsuite/tests/typecheck/should_fail/T14048a.stderr new file mode 100644 index 0000000000000000000000000000000000000000..48a91c75259ac23173459b1c46f86505fd066d45 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048a.stderr @@ -0,0 +1,5 @@ + +T14048a.hs:6:1: error: + • Kind signature on data type declaration has non-* return kind + Constraint + • In the data declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048b.hs b/testsuite/tests/typecheck/should_fail/T14048b.hs new file mode 100644 index 0000000000000000000000000000000000000000..d2f6f74583a13ab964b2821576430407f5276859 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048b.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T14048b where + +import Data.Kind + +data family Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048b.stderr b/testsuite/tests/typecheck/should_fail/T14048b.stderr new file mode 100644 index 0000000000000000000000000000000000000000..fe78d9f7f5f9942bf6b29bfdf7e97654df705c78 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048b.stderr @@ -0,0 +1,6 @@ + +T14048b.hs:7:1: error: + • Kind signature on data type declaration has non-* + and non-variable return kind + Constraint + • In the data family declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048c.hs b/testsuite/tests/typecheck/should_fail/T14048c.hs new file mode 100644 index 0000000000000000000000000000000000000000..e81e454d31b2ea996f7efef657a1a1169a70c66e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048c.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T14048c where + +import Data.Kind + +data family Foo :: k +data instance Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048c.stderr b/testsuite/tests/typecheck/should_fail/T14048c.stderr new file mode 100644 index 0000000000000000000000000000000000000000..7e83d1924ca1c5d979a0018024c1e8bf2f2f812e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048c.stderr @@ -0,0 +1,5 @@ + +T14048c.hs:9:1: error: + • Kind signature on data type declaration has non-* return kind + Constraint + • In the data instance declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index b1a0e757ae317931dc0598d6724edb76621ed56a..734561f732a7f4bd12cc69e00a870cf8c7a43ccc 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -457,6 +457,9 @@ test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) test('T13909', normal, compile_fail, ['']) test('T13929', normal, compile_fail, ['']) +test('T14048a', normal, compile_fail, ['']) +test('T14048b', normal, compile_fail, ['']) +test('T14048c', normal, compile_fail, ['']) test('T14232', normal, compile_fail, ['']) test('T14325', normal, compile_fail, ['']) test('T14350', normal, compile_fail, [''])