summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-03-29 10:18:03 +0300
committerVladislav Zavialov <vlad.z.4096@gmail.com>2019-09-25 21:06:04 +0300
commit0b5eede97804ec3dfbfa9df9f97bcfe2aa369f6b (patch)
treec6f6452ba5ae3a3d9f2986c79e054ea55a601884
parent795986aaf33e2ffc233836b86a92a77366c91db2 (diff)
downloadhaskell-0b5eede97804ec3dfbfa9df9f97bcfe2aa369f6b.tar.gz
Standalone kind signatures (#16794)wip/top-level-kind-signatures
Implements GHC Proposal #54: .../ghc-proposals/blob/master/proposals/0054-kind-signatures.rst With this patch, a type constructor can now be given an explicit standalone kind signature: {-# LANGUAGE StandaloneKindSignatures #-} type Functor :: (Type -> Type) -> Constraint class Functor f where fmap :: (a -> b) -> f a -> f b This is a replacement for CUSKs (complete user-specified kind signatures), which are now scheduled for deprecation. User-facing changes ------------------- * A new extension flag has been added, -XStandaloneKindSignatures, which implies -XNoCUSKs. * There is a new syntactic construct, a standalone kind signature: type <name> :: <kind> Declarations of data types, classes, data families, type families, and type synonyms may be accompanied by a standalone kind signature. * A standalone kind signature enables polymorphic recursion in types, just like a function type signature enables polymorphic recursion in terms. This obviates the need for CUSKs. * TemplateHaskell AST has been extended with 'KiSigD' to represent standalone kind signatures. * GHCi :info command now prints the kind signature of type constructors: ghci> :info Functor type Functor :: (Type -> Type) -> Constraint ... Limitations ----------- * 'forall'-bound type variables of a standalone kind signature do not scope over the declaration body, even if the -XScopedTypeVariables is enabled. See #16635 and #16734. * Wildcards are not allowed in standalone kind signatures, as partial signatures do not allow for polymorphic recursion. * Associated types may not be given an explicit standalone kind signature. Instead, they are assumed to have a CUSK if the parent class has a standalone kind signature and regardless of the -XCUSKs flag. * Standalone kind signatures do not support multiple names at the moment: type T1, T2 :: Type -> Type -- rejected type T1 = Maybe type T2 = Either String See #16754. * Creative use of equality constraints in standalone kind signatures may lead to GHC panics: type C :: forall (a :: Type) -> a ~ Int => Constraint class C a where f :: C a => a -> Int See #16758. Implementation notes -------------------- * The heart of this patch is the 'kcDeclHeader' function, which is used to kind-check a declaration header against its standalone kind signature. It does so in two rounds: 1. check user-written binders 2. instantiate invisible binders a la 'checkExpectedKind' * 'kcTyClGroup' now partitions declarations into declarations with a standalone kind signature or a CUSK (kinded_decls) and declarations without either (kindless_decls): * 'kinded_decls' are kind-checked with 'checkInitialKinds' * 'kindless_decls' are kind-checked with 'getInitialKinds' * DerivInfo has been extended with a new field: di_scoped_tvs :: ![(Name,TyVar)] These variables must be added to the context in case the deriving clause references tcTyConScopedTyVars. See #16731.
-rw-r--r--compiler/GHC/Hs/Decls.hs134
-rw-r--r--compiler/GHC/Hs/Extension.hs6
-rw-r--r--compiler/GHC/Hs/Instances.hs5
-rw-r--r--compiler/GHC/Hs/Types.hs29
-rw-r--r--compiler/GHC/ThToHs.hs6
-rw-r--r--compiler/basicTypes/NameEnv.hs4
-rw-r--r--compiler/deSugar/DsMeta.hs11
-rw-r--r--compiler/hieFile/HieAst.hs18
-rw-r--r--compiler/iface/IfaceSyn.hs110
-rw-r--r--compiler/iface/IfaceType.hs94
-rw-r--r--compiler/main/DynFlags.hs4
-rw-r--r--compiler/parser/Parser.y14
-rw-r--r--compiler/parser/RdrHsSyn.hs25
-rw-r--r--compiler/prelude/THNames.hs9
-rw-r--r--compiler/prelude/TysWiredIn.hs4
-rw-r--r--compiler/rename/RnBinds.hs8
-rw-r--r--compiler/rename/RnSource.hs165
-rw-r--r--compiler/rename/RnTypes.hs19
-rw-r--r--compiler/rename/RnUtils.hs2
-rw-r--r--compiler/typecheck/TcDeriv.hs18
-rw-r--r--compiler/typecheck/TcEnv.hs9
-rw-r--r--compiler/typecheck/TcHsType.hs606
-rw-r--r--compiler/typecheck/TcInstDcls.hs1
-rw-r--r--compiler/typecheck/TcMType.hs9
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs404
-rw-r--r--compiler/typecheck/TcType.hs3
-rw-r--r--compiler/typecheck/TcValidity.hs11
-rw-r--r--compiler/types/TyCon.hs7
-rw-r--r--compiler/types/Type.hs3
-rw-r--r--docs/users_guide/8.10.1-notes.rst14
-rw-r--r--docs/users_guide/glasgow_exts.rst202
-rw-r--r--libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs1
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs2
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs3
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs1
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs1
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail04.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail06.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail07.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail10.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail17.stderr4
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail22.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail23.stderr4
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail25.stderr4
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail26.stderr4
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail27.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail41.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail42.stderr10
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail45.stderr2
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail46.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail47.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/Rae31.hs2
-rw-r--r--testsuite/tests/dependent/should_compile/mkGADTVars.hs2
-rw-r--r--testsuite/tests/driver/T4437.hs1
-rw-r--r--testsuite/tests/ghci/prog008/ghci.prog008.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T10018.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T10059.stdout7
-rw-r--r--testsuite/tests/ghci/scripts/T11051a.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T11051b.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T12005.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/T12550.stdout9
-rw-r--r--testsuite/tests/ghci/scripts/T13407.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/T13420.stdout3
-rw-r--r--testsuite/tests/ghci/scripts/T13699.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T15341.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/T15546.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/T15827.stdout11
-rw-r--r--testsuite/tests/ghci/scripts/T15872.stdout9
-rw-r--r--testsuite/tests/ghci/scripts/T15941.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T16030.stdout14
-rw-r--r--testsuite/tests/ghci/scripts/T16527.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T4015.stdout17
-rw-r--r--testsuite/tests/ghci/scripts/T4087.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/T4175.stdout31
-rw-r--r--testsuite/tests/ghci/scripts/T5417.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/T5820.stdout8
-rw-r--r--testsuite/tests/ghci/scripts/T6027ghci.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T7627.stdout19
-rw-r--r--testsuite/tests/ghci/scripts/T7730.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/T7872.stdout8
-rw-r--r--testsuite/tests/ghci/scripts/T7873.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/T7939.stdout22
-rw-r--r--testsuite/tests/ghci/scripts/T8469.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T8535.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T8579.stdout8
-rw-r--r--testsuite/tests/ghci/scripts/T8674.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T9181.stdout82
-rw-r--r--testsuite/tests/ghci/scripts/T9881.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/ghci008.stdout5
-rw-r--r--testsuite/tests/ghci/scripts/ghci011.stdout12
-rw-r--r--testsuite/tests/ghci/scripts/ghci019.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci020.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci023.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/ghci025.stdout18
-rw-r--r--testsuite/tests/ghci/scripts/ghci026.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/ghci027.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/ghci030.stdout8
-rw-r--r--testsuite/tests/ghci/scripts/ghci031.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/ghci033.stdout1
-rw-r--r--testsuite/tests/ghci/scripts/ghci040.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci041.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci042.stdout16
-rw-r--r--testsuite/tests/ghci/scripts/ghci051.stdout24
-rw-r--r--testsuite/tests/ghci/scripts/ghci059.stdout3
-rw-r--r--testsuite/tests/ghci/should_run/T10145.stdout4
-rw-r--r--testsuite/tests/ghci/should_run/T11825.stdout1
-rw-r--r--testsuite/tests/ghci/should_run/T12525.stdout1
-rw-r--r--testsuite/tests/ghci/should_run/T9914.stdout8
-rw-r--r--testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr39
-rw-r--r--testsuite/tests/indexed-types/should_fail/T9167.stderr8
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout5
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr5
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr1
-rw-r--r--testsuite/tests/polykinds/CuskFam.hs16
-rw-r--r--testsuite/tests/polykinds/all.T1
-rw-r--r--testsuite/tests/rename/should_fail/rnfail055.stderr48
-rw-r--r--testsuite/tests/roles/should_fail/Roles12.stderr4
-rw-r--r--testsuite/tests/roles/should_fail/T9204.stderr4
-rw-r--r--testsuite/tests/saks/should_compile/T16721.script4
-rw-r--r--testsuite/tests/saks/should_compile/T16721.stdout4
-rw-r--r--testsuite/tests/saks/should_compile/T16723.hs10
-rw-r--r--testsuite/tests/saks/should_compile/T16724.hs15
-rw-r--r--testsuite/tests/saks/should_compile/T16724.script5
-rw-r--r--testsuite/tests/saks/should_compile/T16724.stdout6
-rw-r--r--testsuite/tests/saks/should_compile/T16726.hs17
-rw-r--r--testsuite/tests/saks/should_compile/T16731.hs14
-rw-r--r--testsuite/tests/saks/should_compile/T16756a.hs12
-rw-r--r--testsuite/tests/saks/should_compile/T16758.hs14
-rw-r--r--testsuite/tests/saks/should_compile/T17164.hs14
-rw-r--r--testsuite/tests/saks/should_compile/T17164.stderr7
-rw-r--r--testsuite/tests/saks/should_compile/all.T49
-rw-r--r--testsuite/tests/saks/should_compile/saks001.hs8
-rw-r--r--testsuite/tests/saks/should_compile/saks002.hs8
-rw-r--r--testsuite/tests/saks/should_compile/saks003.hs8
-rw-r--r--testsuite/tests/saks/should_compile/saks004.hs10
-rw-r--r--testsuite/tests/saks/should_compile/saks005.hs12
-rw-r--r--testsuite/tests/saks/should_compile/saks006.hs22
-rw-r--r--testsuite/tests/saks/should_compile/saks007.hs15
-rw-r--r--testsuite/tests/saks/should_compile/saks008.hs12
-rw-r--r--testsuite/tests/saks/should_compile/saks009.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks010.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks014.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks015.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks016.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks017.hs16
-rw-r--r--testsuite/tests/saks/should_compile/saks018.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks019.hs11
-rw-r--r--testsuite/tests/saks/should_compile/saks020.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks021.hs9
-rw-r--r--testsuite/tests/saks/should_compile/saks023.script5
-rw-r--r--testsuite/tests/saks/should_compile/saks023.stdout1
-rw-r--r--testsuite/tests/saks/should_compile/saks024.hs15
-rw-r--r--testsuite/tests/saks/should_compile/saks025.hs12
-rw-r--r--testsuite/tests/saks/should_compile/saks025.script3
-rw-r--r--testsuite/tests/saks/should_compile/saks025.stdout1
-rw-r--r--testsuite/tests/saks/should_compile/saks026.hs15
-rw-r--r--testsuite/tests/saks/should_compile/saks027.hs10
-rw-r--r--testsuite/tests/saks/should_compile/saks027.stderr7
-rw-r--r--testsuite/tests/saks/should_compile/saks028.hs14
-rw-r--r--testsuite/tests/saks/should_compile/saks028.stderr1
-rw-r--r--testsuite/tests/saks/should_compile/saks029.hs13
-rw-r--r--testsuite/tests/saks/should_compile/saks030.hs28
-rw-r--r--testsuite/tests/saks/should_compile/saks031.hs16
-rw-r--r--testsuite/tests/saks/should_compile/saks032.hs21
-rw-r--r--testsuite/tests/saks/should_compile/saks033.hs13
-rw-r--r--testsuite/tests/saks/should_compile/saks034.hs11
-rw-r--r--testsuite/tests/saks/should_compile/saks034.script4
-rw-r--r--testsuite/tests/saks/should_compile/saks034.stdout2
-rw-r--r--testsuite/tests/saks/should_compile/saks035.hs12
-rw-r--r--testsuite/tests/saks/should_compile/saks035.script4
-rw-r--r--testsuite/tests/saks/should_compile/saks035.stdout2
-rw-r--r--testsuite/tests/saks/should_compile/saks036.hs12
-rw-r--r--testsuite/tests/saks/should_fail/T16722.hs9
-rw-r--r--testsuite/tests/saks/should_fail/T16722.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/T16725.hs8
-rw-r--r--testsuite/tests/saks/should_fail/T16725.stderr3
-rw-r--r--testsuite/tests/saks/should_fail/T16727a.hs9
-rw-r--r--testsuite/tests/saks/should_fail/T16727a.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/T16727b.hs6
-rw-r--r--testsuite/tests/saks/should_fail/T16727b.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/T16756b.hs11
-rw-r--r--testsuite/tests/saks/should_fail/T16756b.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/T16826.hs14
-rw-r--r--testsuite/tests/saks/should_fail/T16826.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/all.T32
-rw-r--r--testsuite/tests/saks/should_fail/saks007_fail.hs16
-rw-r--r--testsuite/tests/saks/should_fail/saks007_fail.stderr8
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail001.hs8
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail001.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail002.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail002.stderr6
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail003.hs7
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail003.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail004.hs10
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail004.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail005.hs14
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail005.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail006.hs14
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail006.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail007.hs8
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail007.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail008.hs9
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail008.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail009.hs9
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail009.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail010.hs8
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail010.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail011.hs10
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail011.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail012.hs8
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail012.stderr5
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail013.hs10
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail013.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail014.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail014.stderr11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail015.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail015.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail016.hs13
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail016.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail017.hs12
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail017.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail018.hs13
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail018.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail019.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail019.stderr6
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail020.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail020.stderr6
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail021.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail021.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail022.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail022.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail023.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail023.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail024.hs7
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail024.stderr3
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail025.hs11
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail025.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/T12035.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T12035j.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T12042.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T3468.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T9201.stderr3
-rw-r--r--testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail210.stderr2
244 files changed, 3148 insertions, 585 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 701c8b1a06..c43a27cef2 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -20,18 +20,20 @@ module GHC.Hs.Decls (
-- * Toplevel declarations
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
+ StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName,
-- ** Class or type declarations
TyClDecl(..), LTyClDecl, DataDeclRn(..),
TyClGroup(..),
tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
+ tyClGroupKindSigs,
isClassDecl, isDataDecl, isSynDecl, tcdName,
isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
tyFamInstDeclName, tyFamInstDeclLName,
countTyClDecls, pprTyClDeclFlavour,
tyClDeclLName, tyClDeclTyVars,
- hsDeclHasCusk, famDeclHasCusk,
+ hsDeclHasCusk, famResultKindSignature,
FamilyDecl(..), LFamilyDecl,
-- ** Instance declarations
@@ -136,6 +138,7 @@ data HsDecl p
| DerivD (XDerivD p) (DerivDecl p) -- ^ Deriving declaration
| ValD (XValD p) (HsBind p) -- ^ Value declaration
| SigD (XSigD p) (Sig p) -- ^ Signature declaration
+ | KindSigD (XKindSigD p) (StandaloneKindSig p) -- ^ Standalone kind signature
| DefD (XDefD p) (DefaultDecl p) -- ^ 'default' declaration
| ForD (XForD p) (ForeignDecl p) -- ^ Foreign declaration
| WarningD (XWarningD p) (WarnDecls p) -- ^ Warning declaration
@@ -152,6 +155,7 @@ type instance XInstD (GhcPass _) = NoExtField
type instance XDerivD (GhcPass _) = NoExtField
type instance XValD (GhcPass _) = NoExtField
type instance XSigD (GhcPass _) = NoExtField
+type instance XKindSigD (GhcPass _) = NoExtField
type instance XDefD (GhcPass _) = NoExtField
type instance XForD (GhcPass _) = NoExtField
type instance XWarningD (GhcPass _) = NoExtField
@@ -278,6 +282,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
ppr (DerivD _ deriv) = ppr deriv
ppr (ForD _ fd) = ppr fd
ppr (SigD _ sd) = ppr sd
+ ppr (KindSigD _ ksd) = ppr ksd
ppr (RuleD _ rd) = ppr rd
ppr (WarningD _ wd) = ppr wd
ppr (AnnD _ ad) = ppr ad
@@ -304,6 +309,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
then Nothing
else Just (ppr val_decls),
ppr_ds (tyClGroupRoleDecls tycl_decls),
+ ppr_ds (tyClGroupKindSigs tycl_decls),
ppr_ds (tyClGroupTyClDecls tycl_decls),
ppr_ds (tyClGroupInstDecls tycl_decls),
ppr_ds deriv_decls,
@@ -658,7 +664,7 @@ tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
-tcdName :: TyClDecl pass -> (IdP pass)
+tcdName :: TyClDecl pass -> IdP pass
tcdName = unLoc . tyClDeclLName
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
@@ -682,25 +688,21 @@ countTyClDecls decls
-- | Does this declaration have a complete, user-supplied kind signature?
-- See Note [CUSKs: complete user-supplied kind signatures]
-hsDeclHasCusk
- :: Bool -- True <=> the -XCUSKs extension is enabled
- -> TyClDecl GhcRn
- -> Bool
-hsDeclHasCusk _cusks_enabled@False _ = False
-hsDeclHasCusk cusks_enabled (FamDecl { tcdFam = fam_decl })
- = famDeclHasCusk cusks_enabled False fam_decl
- -- False: this is not: an associated type of a class with no cusk
-hsDeclHasCusk _cusks_enabled@True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
- -- NB: Keep this synchronized with 'getInitialKind'
- = hsTvbAllKinded tyvars && rhs_annotated rhs
- where
- rhs_annotated (L _ ty) = case ty of
- HsParTy _ lty -> rhs_annotated lty
- HsKindSig {} -> True
- _ -> False
-hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
-hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
-hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec
+hsDeclHasCusk :: TyClDecl GhcRn -> Bool
+hsDeclHasCusk (FamDecl { tcdFam =
+ FamilyDecl { fdInfo = fam_info
+ , fdTyVars = tyvars
+ , fdResultSig = L _ resultSig } }) =
+ case fam_info of
+ ClosedTypeFamily {} -> hsTvbAllKinded tyvars
+ && isJust (famResultKindSignature resultSig)
+ _ -> True -- Un-associated open type/data families have CUSKs
+hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
+ = hsTvbAllKinded tyvars && isJust (hsTyKindSig rhs)
+hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
+hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
+hsDeclHasCusk (FamDecl { tcdFam = XFamilyDecl nec }) = noExtCon nec
+hsDeclHasCusk (XTyClDecl nec) = noExtCon nec
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -742,10 +744,13 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (TyClGroup p) where
ppr (TyClGroup { group_tyclds = tyclds
, group_roles = roles
+ , group_kisigs = kisigs
, group_instds = instds
}
)
- = ppr tyclds $$
+ = hang (text "TyClGroup") 2 $
+ ppr kisigs $$
+ ppr tyclds $$
ppr roles $$
ppr instds
ppr (XTyClGroup x) = ppr x
@@ -777,8 +782,8 @@ pprTyClDeclFlavour (ClassDecl {}) = text "class"
pprTyClDeclFlavour (SynDecl {}) = text "type"
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
= pprFlavour info <+> text "family"
-pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
- = ppr x
+pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl nec })
+ = noExtCon nec
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
= ppr nd
pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
@@ -910,6 +915,7 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis]
= TyClGroup { group_ext :: XCTyClGroup pass
, group_tyclds :: [LTyClDecl pass]
, group_roles :: [LRoleAnnotDecl pass]
+ , group_kisigs :: [LStandaloneKindSig pass]
, group_instds :: [LInstDecl pass] }
| XTyClGroup (XXTyClGroup pass)
@@ -926,6 +932,8 @@ tyClGroupInstDecls = concatMap group_instds
tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
tyClGroupRoleDecls = concatMap group_roles
+tyClGroupKindSigs :: [TyClGroup pass] -> [LStandaloneKindSig pass]
+tyClGroupKindSigs = concatMap group_kisigs
{- *********************************************************************
@@ -1024,6 +1032,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
type instance XNoSig (GhcPass _) = NoExtField
type instance XCKindSig (GhcPass _) = NoExtField
+
type instance XTyVarSig (GhcPass _) = NoExtField
type instance XXFamilyResultSig (GhcPass _) = NoExtCon
@@ -1081,32 +1090,15 @@ data FamilyInfo pass
-- said "type family Foo x where .."
| ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
--- | Does this family declaration have a complete, user-supplied kind signature?
--- See Note [CUSKs: complete user-supplied kind signatures]
-famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled
- -> Bool -- ^ True <=> this is an associated type family,
- -- and the parent class has /no/ CUSK
- -> FamilyDecl (GhcPass pass)
- -> Bool
-famDeclHasCusk _cusks_enabled@False _ _ = False
-famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
- (FamilyDecl { fdInfo = fam_info
- , fdTyVars = tyvars
- , fdResultSig = L _ resultSig })
- = case fam_info of
- ClosedTypeFamily {} -> hsTvbAllKinded tyvars
- && hasReturnKindSignature resultSig
- _ -> not assoc_with_no_cusk
- -- Un-associated open type/data families have CUSKs
- -- Associated type families have CUSKs iff the parent class does
-
-famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec
-
--- | Does this family declaration have user-supplied return kind signature?
-hasReturnKindSignature :: FamilyResultSig a -> Bool
-hasReturnKindSignature (NoSig _) = False
-hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False
-hasReturnKindSignature _ = True
+famResultKindSignature :: FamilyResultSig (GhcPass p) -> Maybe (LHsKind (GhcPass p))
+famResultKindSignature (NoSig _) = Nothing
+famResultKindSignature (KindSig _ ki) = Just ki
+famResultKindSignature (TyVarSig _ bndr) =
+ case unLoc bndr of
+ UserTyVar _ _ -> Nothing
+ KindedTyVar _ _ ki -> Just ki
+ XTyVarBndr nec -> noExtCon nec
+famResultKindSignature (XFamilyResultSig nec) = noExtCon nec
-- | Maybe return name of the result type variable
resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
@@ -1137,7 +1129,7 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
NoSig _ -> empty
KindSig _ kind -> dcolon <+> ppr kind
TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
- XFamilyResultSig x -> ppr x
+ XFamilyResultSig nec -> noExtCon nec
pp_inj = case mb_inj of
Just (L _ (InjectivityAnn lhs rhs)) ->
hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
@@ -1149,7 +1141,7 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
Nothing -> text ".."
Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
_ -> (empty, empty)
-pprFamilyDecl _ (XFamilyDecl x) = ppr x
+pprFamilyDecl _ (XFamilyDecl nec) = noExtCon nec
pprFlavour :: FamilyInfo pass -> SDoc
pprFlavour DataFamily = text "data"
@@ -1203,6 +1195,7 @@ data HsDataDefn pass -- The payload of a data type defn
| XHsDataDefn (XXHsDataDefn pass)
type instance XCHsDataDefn (GhcPass _) = NoExtField
+
type instance XXHsDataDefn (GhcPass _) = NoExtCon
-- | Haskell Deriving clause
@@ -1269,6 +1262,37 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
_ -> (ppDerivStrategy dcs, empty)
ppr (XHsDerivingClause x) = ppr x
+-- | Located Standalone Kind Signature
+type LStandaloneKindSig pass = Located (StandaloneKindSig pass)
+
+data StandaloneKindSig pass
+ = StandaloneKindSig (XStandaloneKindSig pass)
+ (Located (IdP pass)) -- Why a single binder? See #16754
+ (LHsSigType pass) -- Why not LHsSigWcType? See Note [Wildcards in standalone kind signatures]
+ | XStandaloneKindSig (XXStandaloneKindSig pass)
+
+type instance XStandaloneKindSig (GhcPass p) = NoExtField
+type instance XXStandaloneKindSig (GhcPass p) = NoExtCon
+
+standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
+standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
+standaloneKindSigName (XStandaloneKindSig nec) = noExtCon nec
+
+{- Note [Wildcards in standalone kind signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Standalone kind signatures enable polymorphic recursion, and it is unclear how
+to reconcile this with partial type signatures, so we disallow wildcards in
+them.
+
+We reject wildcards in 'rnStandaloneKindSignature' by returning False for
+'StandaloneKindSigCtx' in 'wildCardsAllowed'.
+
+The alternative design is to have special treatment for partial standalone kind
+signatures, much like we have special treatment for partial type signatures in
+terms. However, partial standalone kind signatures are not a proper replacement
+for CUSKs, so this would be a separate feature.
+-}
+
data NewOrData
= NewType -- ^ @newtype Blah ...@
| DataType -- ^ @data Blah ...@
@@ -1279,6 +1303,7 @@ newOrDataToFlavour :: NewOrData -> TyConFlavour
newOrDataToFlavour NewType = NewtypeFlavour
newOrDataToFlavour DataType = DataTypeFlavour
+
-- | Located data Constructor Declaration
type LConDecl pass = Located (ConDecl pass)
-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
@@ -1443,6 +1468,11 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsDataDefn p) where
ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
+instance (p ~ GhcPass pass, OutputableBndrId p)
+ => Outputable (StandaloneKindSig p) where
+ ppr (StandaloneKindSig _ v ki) = text "type" <+> ppr v <+> text "::" <+> ppr ki
+ ppr (XStandaloneKindSig nec) = noExtCon nec
+
instance Outputable NewOrData where
ppr NewType = text "newtype"
ppr DataType = text "data"
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index f360e1c32e..35afc5f8d3 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -280,6 +280,10 @@ type ForallXFixitySig (c :: * -> Constraint) (x :: *) =
, c (XXFixitySig x)
)
+-- StandaloneKindSig type families
+type family XStandaloneKindSig x
+type family XXStandaloneKindSig x
+
-- =====================================================================
-- Type families for the HsDecls extension points
@@ -289,6 +293,7 @@ type family XInstD x
type family XDerivD x
type family XValD x
type family XSigD x
+type family XKindSigD x
type family XDefD x
type family XForD x
type family XWarningD x
@@ -305,6 +310,7 @@ type ForallXHsDecl (c :: * -> Constraint) (x :: *) =
, c (XDerivD x)
, c (XValD x)
, c (XSigD x)
+ , c (XKindSigD x)
, c (XDefD x)
, c (XForD x)
, c (XWarningD x)
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index d55e20c2e7..b3a33df43c 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -86,6 +86,11 @@ deriving instance Data (FixitySig GhcPs)
deriving instance Data (FixitySig GhcRn)
deriving instance Data (FixitySig GhcTc)
+-- deriving instance (DataId p) => Data (StandaloneKindSig p)
+deriving instance Data (StandaloneKindSig GhcPs)
+deriving instance Data (StandaloneKindSig GhcRn)
+deriving instance Data (StandaloneKindSig GhcTc)
+
-- deriving instance (DataIdLR p p) => Data (HsPatSynDir p)
deriving instance Data (HsPatSynDir GhcPs)
deriving instance Data (HsPatSynDir GhcRn)
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index f14d59ba4a..04fd1ee8e6 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -62,6 +62,7 @@ module GHC.Hs.Types (
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
ignoreParens, hsSigType, hsSigWcType,
hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
+ hsTyKindSig,
hsConDetailsArgs,
-- Printing
@@ -79,7 +80,7 @@ import {-# SOURCE #-} GHC.Hs.Expr ( HsSplice, pprSplice )
import GHC.Hs.Extension
import Id ( Id )
-import Name( Name )
+import Name( Name, NamedThing(getName) )
import RdrName ( RdrName )
import DataCon( HsSrcBang(..), HsImplBang(..),
SrcStrictness(..), SrcUnpackedness(..) )
@@ -505,6 +506,7 @@ data HsTyVarBndr pass
type instance XUserTyVar (GhcPass _) = NoExtField
type instance XKindedTyVar (GhcPass _) = NoExtField
+
type instance XXTyVarBndr (GhcPass _) = NoExtCon
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
@@ -517,6 +519,11 @@ isHsKindedTyVar (XTyVarBndr {}) = False
hsTvbAllKinded :: LHsQTyVars pass -> Bool
hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
+instance NamedThing (HsTyVarBndr GhcRn) where
+ getName (UserTyVar _ v) = unLoc v
+ getName (KindedTyVar _ v _) = unLoc v
+ getName (XTyVarBndr nec) = noExtCon nec
+
-- | Haskell Type
data HsType pass
= HsForAllTy -- See Note [HsType binders]
@@ -1076,6 +1083,24 @@ hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec
+-- | Get the kind signature of a type, ignoring parentheses:
+--
+-- hsTyKindSig `Maybe ` = Nothing
+-- hsTyKindSig `Maybe :: Type -> Type ` = Just `Type -> Type`
+-- hsTyKindSig `Maybe :: ((Type -> Type))` = Just `Type -> Type`
+--
+-- This is used to extract the result kind of type synonyms with a CUSK:
+--
+-- type S = (F :: res_kind)
+-- ^^^^^^^^
+--
+hsTyKindSig :: LHsType pass -> Maybe (LHsKind pass)
+hsTyKindSig lty =
+ case unLoc lty of
+ HsParTy _ lty' -> hsTyKindSig lty'
+ HsKindSig _ _ k -> Just k
+ _ -> Nothing
+
---------------------
ignoreParens :: LHsType pass -> LHsType pass
ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty
@@ -1449,7 +1474,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsTyVarBndr p) where
ppr (UserTyVar _ n) = ppr n
ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
- ppr (XTyVarBndr n) = ppr n
+ ppr (XTyVarBndr nec) = noExtCon nec
instance (p ~ GhcPass pass,Outputable thing)
=> Outputable (HsImplicitBndrs p thing) where
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index ca38d07ddc..f49d6ff0b2 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -180,6 +180,12 @@ cvtDec (TH.SigD nm typ)
; returnJustL $ Hs.SigD noExtField
(TypeSig noExtField [nm'] (mkLHsSigWcType ty')) }
+cvtDec (TH.KiSigD nm ki)
+ = do { nm' <- tconNameL nm
+ ; ki' <- cvtType ki
+ ; let sig' = StandaloneKindSig noExtField nm' (mkLHsSigType ki')
+ ; returnJustL $ Hs.KindSigD noExtField sig' }
+
cvtDec (TH.InfixD fx nm)
-- Fixity signatures are allowed for variables, constructors, and types
-- the renamer automatically looks for types during renaming, even when
diff --git a/compiler/basicTypes/NameEnv.hs b/compiler/basicTypes/NameEnv.hs
index 5f6bdc5846..03c2150102 100644
--- a/compiler/basicTypes/NameEnv.hs
+++ b/compiler/basicTypes/NameEnv.hs
@@ -11,7 +11,7 @@ module NameEnv (
NameEnv,
-- ** Manipulating these environments
- mkNameEnv,
+ mkNameEnv, mkNameEnvWith,
emptyNameEnv, isEmptyNameEnv,
unitNameEnv, nameEnvElts,
extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
@@ -92,6 +92,7 @@ type NameEnv a = UniqFM a -- Domain is Name
emptyNameEnv :: NameEnv a
isEmptyNameEnv :: NameEnv a -> Bool
mkNameEnv :: [(Name,a)] -> NameEnv a
+mkNameEnvWith :: (a -> Name) -> [a] -> NameEnv a
nameEnvElts :: NameEnv a -> [a]
alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
@@ -121,6 +122,7 @@ extendNameEnvList x l = addListToUFM x l
lookupNameEnv x y = lookupUFM x y
alterNameEnv = alterUFM
mkNameEnv l = listToUFM l
+mkNameEnvWith f = mkNameEnv . map (\a -> (f a, a))
elemNameEnv x y = elemUFM x y
plusNameEnv x y = plusUFM x y
plusNameEnv_C f x y = plusUFM_C f x y
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index c37d366d5e..7baa748faa 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -140,6 +140,7 @@ repTopDs group@(HsGroup { hs_valds = valds
; _ <- mapM no_splice splcds
; tycl_ds <- mapM repTyClD (tyClGroupTyClDecls tyclds)
; role_ds <- mapM repRoleD (concatMap group_roles tyclds)
+ ; kisig_ds <- mapM repKiSigD (concatMap group_kisigs tyclds)
; inst_ds <- mapM repInstD instds
; deriv_ds <- mapM repStandaloneDerivD derivds
; fix_ds <- mapM repFixD fixds
@@ -155,6 +156,7 @@ repTopDs group@(HsGroup { hs_valds = valds
-- more needed
; return (de_loc $ sort_by_loc $
val_ds ++ catMaybes tycl_ds ++ role_ds
+ ++ kisig_ds
++ (concat fix_ds)
++ inst_ds ++ rule_ds ++ for_ds
++ ann_ds ++ deriv_ds) }) ;
@@ -348,6 +350,13 @@ repRoleD (dL->L loc (RoleAnnotDecl _ tycon roles))
repRoleD _ = panic "repRoleD"
-------------------------
+repKiSigD :: LStandaloneKindSig GhcRn -> DsM (SrcSpan, Core TH.DecQ)
+repKiSigD (dL->L loc kisig) =
+ case kisig of
+ StandaloneKindSig _ v ki -> rep_ty_sig kiSigDName loc ki v
+ XStandaloneKindSig nec -> noExtCon nec
+
+-------------------------
repDataDefn :: Core TH.Name
-> Either (Core [TH.TyVarBndrQ])
-- the repTyClD case
@@ -870,7 +879,7 @@ rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> Located Name
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig mk_sig loc sig_ty nm
| HsIB { hsib_body = hs_ty } <- sig_ty
- , (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy hs_ty
+ , (explicit_tvs, ctxt, ty) <- splitLHsSigmaTyInvis hs_ty
= do { nm1 <- lookupLOcc nm
; let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)
; repTyVarBndrWithKind tv name }
diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs
index a1253de735..52f8c59a4d 100644
--- a/compiler/hieFile/HieAst.hs
+++ b/compiler/hieFile/HieAst.hs
@@ -1254,8 +1254,13 @@ instance ( a ~ GhcPass p
XCmd _ -> []
instance ToHie (TyClGroup GhcRn) where
- toHie (TyClGroup _ classes roles instances) = concatM
+ toHie TyClGroup{ group_tyclds = classes
+ , group_roles = roles
+ , group_kisigs = sigs
+ , group_instds = instances } =
+ concatM
[ toHie classes
+ , toHie sigs
, toHie roles
, toHie instances
]
@@ -1466,6 +1471,17 @@ instance ( HasLoc thing
where span = loc a
toHie (TS _ (XHsWildCardBndrs _)) = pure []
+instance ToHie (LStandaloneKindSig GhcRn) where
+ toHie (L sp sig) = concatM [makeNode sig sp, toHie sig]
+
+instance ToHie (StandaloneKindSig GhcRn) where
+ toHie sig = concatM $ case sig of
+ StandaloneKindSig _ name typ ->
+ [ toHie $ C TyDecl name
+ , toHie $ TS (ResolvedScopes []) typ
+ ]
+ XStandaloneKindSig _ -> []
+
instance ToHie (SigContext (LSig GhcRn)) where
toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of
TypeSig _ names typ ->
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 688998f96d..f86ca458d7 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -69,6 +69,7 @@ import TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
import Util( dropList, filterByList, notNull, unzipWith )
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
import Lexeme (isLexSym)
+import TysWiredIn ( constraintKindTyConName )
import Control.Monad
import System.IO.Unsafe
@@ -730,6 +731,14 @@ pprClassRoles ss clas binders roles =
binders
roles
+pprClassStandaloneKindSig :: ShowSub -> IfaceTopBndr -> IfaceKind -> SDoc
+pprClassStandaloneKindSig ss clas =
+ pprStandaloneKindSig (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
+
+constraintIfaceKind :: IfaceKind
+constraintIfaceKind =
+ IfaceTyConApp (IfaceTyCon constraintKindTyConName (IfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil
+
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
-- See Note [Pretty-printing TyThings] in PprTyThing
@@ -741,10 +750,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
ifBinders = binders })
| gadt = vcat [ pp_roles
+ , pp_ki_sig
, pp_nd <+> pp_lhs <+> pp_kind <+> pp_where
, nest 2 (vcat pp_cons)
, nest 2 $ ppShowIface ss pp_extra ]
| otherwise = vcat [ pp_roles
+ , pp_ki_sig
, hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
, nest 2 $ ppShowIface ss pp_extra ]
where
@@ -759,26 +770,45 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
cons = visibleIfConDecls condecls
pp_where = ppWhen (gadt && not (null cons)) $ text "where"
pp_cons = ppr_trim (map show_con cons) :: [SDoc]
- pp_kind
- | isIfaceLiftedTypeKind kind = empty
- | otherwise = dcolon <+> ppr kind
+ pp_kind = ppUnless (if ki_sig_printable
+ then isIfaceTauType kind
+ -- Even in the presence of a standalone kind signature, a non-tau
+ -- result kind annotation cannot be discarded as it determines the arity.
+ -- See Note [Arity inference in kcDeclHeader_sig] in TcHsType
+ else isIfaceLiftedTypeKind kind)
+ (dcolon <+> ppr kind)
pp_lhs = case parent of
- IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing
+ IfNoParent -> pprIfaceDeclHead suppress_bndr_sig context ss tycon binders
IfDataInstance{}
-> text "instance" <+> pp_data_inst_forall
<+> pprIfaceTyConParent parent
pp_roles
| is_data_instance = empty
- | otherwise = pprRoles (== Representational)
- (pprPrefixIfDeclBndr
- (ss_how_much ss)
- (occName tycon))
- binders roles
+ | otherwise = pprRoles (== Representational) name_doc binders roles
-- Don't display roles for data family instances (yet)
-- See discussion on #8672.
+ ki_sig_printable =
+ -- If we print a standalone kind signature for a data instance, we leak
+ -- the internal constructor name:
+ --
+ -- type T15827.R:Dka :: forall k. k -> *
+ -- data instance forall k (a :: k). D a = MkD (Proxy a)
+ --
+ -- This T15827.R:Dka is a compiler-generated type constructor for the
+ -- data instance.
+ not is_data_instance
+
+ pp_ki_sig = ppWhen ki_sig_printable $
+ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders kind)
+
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_bndr_sig = SuppressBndrSig ki_sig_printable
+
+ name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon)
+
add_bars [] = Outputable.empty
add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
@@ -801,8 +831,11 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
, ifBinders = binders
, ifBody = IfAbstractClass })
= vcat [ pprClassRoles ss clas binders roles
- , text "class" <+> pprIfaceDeclHead [] ss clas binders Nothing
- <+> pprFundeps fds ]
+ , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
+ , text "class" <+> pprIfaceDeclHead suppress_bndr_sig [] ss clas binders <+> pprFundeps fds ]
+ where
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_bndr_sig = SuppressBndrSig True
pprIfaceDecl ss (IfaceClass { ifName = clas
, ifRoles = roles
@@ -815,8 +848,8 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
ifMinDef = minDef
}})
= vcat [ pprClassRoles ss clas binders roles
- , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
- <+> pprFundeps fds <+> pp_where
+ , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
+ , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where
, nest 2 (vcat [ vcat asocs, vcat dsigs
, ppShowAllSubs ss (pprMinDef minDef)])]
where
@@ -842,31 +875,46 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
(\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
text "#-}"
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_bndr_sig = SuppressBndrSig True
+
pprIfaceDecl ss (IfaceSynonym { ifName = tc
, ifBinders = binders
, ifSynRhs = mono_ty
, ifResKind = res_kind})
- = hang (text "type" <+> pprIfaceDeclHead [] ss tc binders Nothing <+> equals)
- 2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau
- , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])
+ = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
+ , hang (text "type" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tc binders <+> equals)
+ 2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau
+ , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])
+ ]
where
(tvs, theta, tau) = splitIfaceSigmaTy mono_ty
+ name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tc)
+
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_bndr_sig = SuppressBndrSig True
pprIfaceDecl ss (IfaceFamily { ifName = tycon
, ifFamFlav = rhs, ifBinders = binders
, ifResKind = res_kind
, ifResVar = res_var, ifFamInj = inj })
| IfaceDataFamilyTyCon <- rhs
- = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing
+ = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
+ , text "data family" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders
+ ]
| otherwise
- = hang (text "type family"
- <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind)
- <+> ppShowRhs ss (pp_where rhs))
- 2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
- $$
- nest 2 (ppShowRhs ss (pp_branches rhs))
+ = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
+ , hang (text "type family"
+ <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders
+ <+> ppShowRhs ss (pp_where rhs))
+ 2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
+ $$
+ nest 2 (ppShowRhs ss (pp_branches rhs))
+ ]
where
+ name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon)
+
pp_where (IfaceClosedSynFamilyTyCon {}) = text "where"
pp_where _ = empty
@@ -900,6 +948,9 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon
$$ ppShowIface ss (text "axiom" <+> ppr ax)
pp_branches _ = Outputable.empty
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_bndr_sig = SuppressBndrSig True
+
pprIfaceDecl _ (IfacePatSyn { ifName = name,
ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,
ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
@@ -948,6 +999,9 @@ pprRoles suppress_if tyCon bndrs roles
in ppUnless (all suppress_if froles || null froles) $
text "type role" <+> tyCon <+> hsep (map ppr froles)
+pprStandaloneKindSig :: SDoc -> IfaceType -> SDoc
+pprStandaloneKindSig tyCon ty = text "type" <+> tyCon <+> text "::" <+> ppr ty
+
pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
= pprInfixVar (isSymOcc name) (ppr_bndr name)
@@ -998,16 +1052,16 @@ pprIfaceTyConParent IfNoParent
pprIfaceTyConParent (IfDataInstance _ tc tys)
= pprIfaceTypeApp topPrec tc tys
-pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
+pprIfaceDeclHead :: SuppressBndrSig
+ -> IfaceContext -> ShowSub -> Name
-> [IfaceTyConBinder] -- of the tycon, for invisible-suppression
- -> Maybe IfaceKind
-> SDoc
-pprIfaceDeclHead context ss tc_occ bndrs m_res_kind
+pprIfaceDeclHead suppress_sig context ss tc_occ bndrs
= sdocWithDynFlags $ \ dflags ->
sep [ pprIfaceContextArr context
, pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)
- <+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)
- , maybe empty (\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]
+ <+> pprIfaceTyConBinders suppress_sig
+ (suppressIfaceInvisibles dflags bndrs bndrs) ]
pprIfaceConDecl :: ShowSub -> Bool
-> IfaceTopBndr
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 9e7021bcc9..e3362b7a68 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -24,6 +24,7 @@ module IfaceType (
IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),
ForallVisFlag(..), ShowForAllFlag(..),
mkIfaceForAllTvBndr,
+ mkIfaceTyConKind,
ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
ifTyConBinderVar, ifTyConBinderName,
@@ -35,6 +36,8 @@ module IfaceType (
appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
-- Printing
+ SuppressBndrSig(..),
+ UseBndrParens(..),
pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
pprIfaceContext, pprIfaceContextArr,
pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
@@ -44,6 +47,7 @@ module IfaceType (
pprIfaceCoercion, pprParendIfaceCoercion,
splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
+ isIfaceTauType,
suppressIfaceInvisibles,
stripIfaceInvisVars,
@@ -106,6 +110,10 @@ ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr
ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr
+ifaceBndrType :: IfaceBndr -> IfaceType
+ifaceBndrType (IfaceIdBndr (_, t)) = t
+ifaceBndrType (IfaceTvBndr (_, t)) = t
+
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
@@ -164,6 +172,15 @@ type IfaceForAllBndr = VarBndr IfaceBndr ArgFlag
mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis
+-- | Build the 'tyConKind' from the binders and the result kind.
+-- Keep in sync with 'mkTyConKind' in types/TyCon.
+mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
+mkIfaceTyConKind bndrs res_kind = foldr mk res_kind bndrs
+ where
+ mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
+ mk (Bndr tv (AnonTCB af)) k = IfaceFunTy af (ifaceBndrType tv) k
+ mk (Bndr tv (NamedTCB vis)) k = IfaceForAllTy (Bndr tv vis) k
+
-- | Stores the arguments in a type application as a list.
-- See @Note [Suppressing invisible arguments]@.
data IfaceAppArgs
@@ -686,11 +703,17 @@ pprIfacePrefixApp ctxt_prec pp_fun pp_tys
| otherwise = maybeParen ctxt_prec appPrec $
hang pp_fun 2 (sep pp_tys)
+isIfaceTauType :: IfaceType -> Bool
+isIfaceTauType (IfaceForAllTy _ _) = False
+isIfaceTauType (IfaceFunTy InvisArg _ _) = False
+isIfaceTauType _ = True
+
-- ----------------------------- Printing binders ------------------------------------
instance Outputable IfaceBndr where
ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
- ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
+ ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr (SuppressBndrSig False)
+ (UseBndrParens False)
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs bs = sep (map ppr bs)
@@ -702,31 +725,60 @@ pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]"
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
-pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
-pprIfaceTvBndr use_parens (tv, ki)
+{- Note [Suppressing binder signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When printing the binders in a 'forall', we want to keep the kind annotations:
+
+ forall (a :: k). blah
+ ^^^^
+ good
+
+On the other hand, when we print the binders of a data declaration in :info,
+the kind information would be redundant due to the standalone kind signature:
+
+ type F :: Symbol -> Type
+ type F (s :: Symbol) = blah
+ ^^^^^^^^^
+ redundant
+
+Here we'd like to omit the kind annotation:
+
+ type F :: Symbol -> Type
+ type F s = blah
+-}
+
+-- | Do we want to suppress kind annotations on binders?
+-- See Note [Suppressing binder signatures]
+newtype SuppressBndrSig = SuppressBndrSig Bool
+
+newtype UseBndrParens = UseBndrParens Bool
+
+pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
+pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens)
+ | suppress_sig = ppr tv
| isIfaceLiftedTypeKind ki = ppr tv
| otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
where
maybe_parens | use_parens = parens
| otherwise = id
-pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
-pprIfaceTyConBinders = sep . map go
+pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
+pprIfaceTyConBinders suppress_sig = sep . map go
where
go :: IfaceTyConBinder -> SDoc
go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr
go (Bndr (IfaceTvBndr bndr) vis) =
-- See Note [Pretty-printing invisible arguments]
case vis of
- AnonTCB VisArg -> ppr_bndr True
- AnonTCB InvisArg -> char '@' <> braces (ppr_bndr False)
+ AnonTCB VisArg -> ppr_bndr (UseBndrParens True)
+ AnonTCB InvisArg -> char '@' <> braces (ppr_bndr (UseBndrParens False))
-- The above case is rare. (See Note [AnonTCB InvisArg] in TyCon.)
-- Should we print these differently?
- NamedTCB Required -> ppr_bndr True
- NamedTCB Specified -> char '@' <> ppr_bndr True
- NamedTCB Inferred -> char '@' <> braces (ppr_bndr False)
+ NamedTCB Required -> ppr_bndr (UseBndrParens True)
+ NamedTCB Specified -> char '@' <> ppr_bndr (UseBndrParens True)
+ NamedTCB Inferred -> char '@' <> braces (ppr_bndr (UseBndrParens False))
where
- ppr_bndr use_parens = pprIfaceTvBndr use_parens bndr
+ ppr_bndr = pprIfaceTvBndr bndr suppress_sig
instance Binary IfaceBndr where
put_ bh (IfaceIdBndr aa) = do
@@ -1045,13 +1097,19 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
-pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)
- = sdocWithDynFlags $ \dflags ->
- if gopt Opt_PrintExplicitForalls dflags
- then braces $ pprIfaceTvBndr False tv
- else pprIfaceTvBndr True tv
-pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _) = pprIfaceTvBndr True tv
-pprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv
+pprIfaceForAllBndr bndr =
+ case bndr of
+ Bndr (IfaceTvBndr tv) Inferred ->
+ sdocWithDynFlags $ \dflags ->
+ if gopt Opt_PrintExplicitForalls dflags
+ then braces $ pprIfaceTvBndr tv suppress_sig (UseBndrParens False)
+ else pprIfaceTvBndr tv suppress_sig (UseBndrParens True)
+ Bndr (IfaceTvBndr tv) _ ->
+ pprIfaceTvBndr tv suppress_sig (UseBndrParens True)
+ Bndr (IfaceIdBndr idv) _ -> pprIfaceIdBndr idv
+ where
+ -- See Note [Suppressing binder signatures] in IfaceType
+ suppress_sig = SuppressBndrSig False
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (tv, kind_co)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 02499d2f74..07b266d24b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -4526,6 +4526,7 @@ xFlagsDeps = [
flagSpec' "TemplateHaskell" LangExt.TemplateHaskell
checkTemplateHaskellOk,
flagSpec "TemplateHaskellQuotes" LangExt.TemplateHaskellQuotes,
+ flagSpec "StandaloneKindSignatures" LangExt.StandaloneKindSignatures,
flagSpec "TraditionalRecordSyntax" LangExt.TraditionalRecordSyntax,
flagSpec "TransformListComp" LangExt.TransformListComp,
flagSpec "TupleSections" LangExt.TupleSections,
@@ -4653,6 +4654,9 @@ impliedXFlags
, (LangExt.TypeInType, turnOn, LangExt.PolyKinds)
, (LangExt.TypeInType, turnOn, LangExt.KindSignatures)
+ -- Standalone kind signatures are a replacement for CUSKs.
+ , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)
+
-- AutoDeriveTypeable is not very useful without DeriveDataTypeable
, (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 276fcb1c5b..f32ce4a5e0 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1049,6 +1049,7 @@ topdecls_semi :: { OrdList (LHsDecl GhcPs) }
topdecl :: { LHsDecl GhcPs }
: cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) }
| ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) }
+ | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) }
| inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) }
| stand_alone_deriving { sLL $1 $> (DerivD noExtField (unLoc $1)) }
| role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) }
@@ -1131,6 +1132,19 @@ ty_decl :: { LTyClDecl GhcPs }
(snd $ unLoc $4) Nothing)
(mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
+-- standalone kind signature
+standalone_kind_sig :: { LStandaloneKindSig GhcPs }
+ : 'type' sks_vars '::' ktypedoc
+ {% amms (mkStandaloneKindSig (comb2 $1 $4) $2 $4)
+ [mj AnnType $1,mu AnnDcolon $3] }
+
+-- See also: sig_vars
+sks_vars :: { Located [Located RdrName] } -- Returned in reverse order
+ : sks_vars ',' oqtycon
+ {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
+ return (sLL $1 $> ($3 : unLoc $1)) }
+ | oqtycon { sL1 $1 [$1] }
+
inst_decl :: { LInstDecl GhcPs }
: 'instance' overlap_pragma inst_type where_inst
{% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 538c20cc8a..0686f669d3 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -23,6 +23,7 @@ module RdrHsSyn (
mkClassDecl,
mkTyData, mkDataFamInst,
mkTySynonym, mkTyFamInstEqn,
+ mkStandaloneKindSig,
mkTyFamInst,
mkFamDecl, mkLHsSigType,
mkInlinePragma,
@@ -239,6 +240,30 @@ mkTySynonym loc lhs rhs
, tcdFixity = fixity
, tcdRhs = rhs })) }
+mkStandaloneKindSig
+ :: SrcSpan
+ -> Located [Located RdrName] -- LHS
+ -> LHsKind GhcPs -- RHS
+ -> P (LStandaloneKindSig GhcPs)
+mkStandaloneKindSig loc lhs rhs =
+ do { vs <- mapM check_lhs_name (unLoc lhs)
+ ; v <- check_singular_lhs (reverse vs)
+ ; return $ cL loc $ StandaloneKindSig noExtField v (mkLHsSigType rhs) }
+ where
+ check_lhs_name v@(unLoc->name) =
+ if isUnqual name && isTcOcc (rdrNameOcc name)
+ then return v
+ else addFatalError (getLoc v) $
+ hang (text "Expected an unqualified type constructor:") 2 (ppr v)
+ check_singular_lhs vs =
+ case vs of
+ [] -> panic "mkStandaloneKindSig: empty left-hand side"
+ [v] -> return v
+ _ -> addFatalError (getLoc lhs) $
+ vcat [ hang (text "Standalone kind signatures do not support multiple names at the moment:")
+ 2 (pprWithCommas ppr vs)
+ , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details." ]
+
mkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs]
-> LHsType GhcPs
-> LHsType GhcPs
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 58f9af770d..0eedeeee9c 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -68,7 +68,7 @@ templateHaskellNames = [
-- Dec
funDName, valDName, dataDName, newtypeDName, tySynDName,
classDName, instanceWithOverlapDName,
- standaloneDerivWithStrategyDName, sigDName, forImpDName,
+ standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName,
pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName,
dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,
@@ -341,7 +341,7 @@ recSName = libFun (fsLit "recS") recSIdKey
-- data Dec = ...
funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
- instanceWithOverlapDName, sigDName, forImpDName, pragInlDName,
+ instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName,
pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,
pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName,
dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,
@@ -357,6 +357,7 @@ classDName = libFun (fsLit "classD")
instanceWithOverlapDName = libFun (fsLit "instanceWithOverlapD") instanceWithOverlapDIdKey
standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey
sigDName = libFun (fsLit "sigD") sigDIdKey
+kiSigDName = libFun (fsLit "kiSigD") kiSigDIdKey
defaultSigDName = libFun (fsLit "defaultSigD") defaultSigDIdKey
forImpDName = libFun (fsLit "forImpD") forImpDIdKey
pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey
@@ -868,7 +869,8 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,
openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey,
newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,
infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,
- patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey :: Unique
+ patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,
+ kiSigDIdKey :: Unique
funDIdKey = mkPreludeMiscIdUnique 320
valDIdKey = mkPreludeMiscIdUnique 321
dataDIdKey = mkPreludeMiscIdUnique 322
@@ -901,6 +903,7 @@ patSynDIdKey = mkPreludeMiscIdUnique 348
patSynSigDIdKey = mkPreludeMiscIdUnique 349
pragCompleteDIdKey = mkPreludeMiscIdUnique 350
implicitParamBindDIdKey = mkPreludeMiscIdUnique 351
+kiSigDIdKey = mkPreludeMiscIdUnique 352
-- type Cxt = ...
cxtIdKey :: Unique
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 4b0141aba3..be4bfe1ce9 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -93,7 +93,7 @@ module TysWiredIn (
-- * Kinds
typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,
- liftedTypeKindTyCon, constraintKindTyCon,
+ liftedTypeKindTyCon, constraintKindTyCon, constraintKindTyConName,
liftedTypeKindTyConName,
-- * Equality predicates
@@ -406,7 +406,7 @@ makeRecoveryTyCon :: TyCon -> TyCon
makeRecoveryTyCon tc
= mkTcTyCon (tyConName tc)
bndrs res_kind
- [] -- No scoped vars
+ noTcTyConScopedTyVars
True -- Fully generalised
flavour -- Keep old flavour
where
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 811a81bdb1..56caee1a2a 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -973,7 +973,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
; when (is_deflt && not defaultSigs_on) $
addErr (defaultSigErr sig)
; new_v <- mapM (lookupSigOccRn ctxt sig) vs
- ; (new_ty, fvs) <- rnHsSigType ty_ctxt ty
+ ; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (ClassOpSig noExtField is_deflt new_v new_ty, fvs) }
where
(v1:_) = vs
@@ -981,7 +981,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
<+> quotes (ppr v1))
renameSig _ (SpecInstSig _ src ty)
- = do { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx ty
+ = do { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx TypeLevel ty
; return (SpecInstSig noExtField src new_ty,fvs) }
-- {-# SPECIALISE #-} pragmas can refer to imported Ids
@@ -998,7 +998,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
ty_ctxt = GenericCtx (text "a SPECIALISE signature for"
<+> quotes (ppr v))
do_one (tys,fvs) ty
- = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt ty
+ = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt TypeLevel ty
; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
renameSig ctxt sig@(InlineSig _ v s)
@@ -1015,7 +1015,7 @@ renameSig ctxt sig@(MinimalSig _ s (L l bf))
renameSig ctxt sig@(PatSynSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
- ; (ty', fvs) <- rnHsSigType ty_ctxt ty
+ ; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (PatSynSig noExtField new_vs ty', fvs) }
where
ty_ctxt = GenericCtx (text "a pattern synonym signature for"
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 229c66fda4..1ab80e755a 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -70,8 +70,9 @@ import Control.Arrow ( first )
import Data.List ( mapAccumL )
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty ( NonEmpty(..) )
-import Data.Maybe ( isNothing, isJust, fromMaybe )
+import Data.Maybe ( isNothing, fromMaybe, mapMaybe )
import qualified Data.Set as Set ( difference, fromList, toList, null )
+import Data.Function ( on )
{- | @rnSourceDecl@ "renames" declarations.
It simultaneously performs dependency analysis and precedence parsing.
@@ -370,7 +371,7 @@ rnHsForeignDecl :: ForeignDecl GhcPs -> RnM (ForeignDecl GhcRn, FreeVars)
rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
= do { topEnv :: HscEnv <- getTopEnv
; name' <- lookupLocatedTopBndrRn name
- ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty
+ ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
-- Mark any PackageTarget style imports as coming from the current package
; let unitId = thisPackage $ hsc_dflags topEnv
@@ -382,7 +383,7 @@ rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
= do { name' <- lookupLocatedOccRn name
- ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty
+ ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
; return (ForeignExport { fd_e_ext = noExtField
, fd_name = name', fd_sig_ty = ty'
, fd_fe = spec }
@@ -607,7 +608,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
, cid_overlap_mode = oflag
, cid_datafam_insts = adts })
= do { (inst_ty', inst_fvs)
- <- rnHsSigType (GenericCtx $ text "an instance declaration") inst_ty
+ <- rnHsSigType (GenericCtx $ text "an instance declaration") TypeLevel inst_ty
; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
; cls <-
case hsTyGetAppHead_maybe head_ty' of
@@ -1288,17 +1289,17 @@ rnTyClDecls :: [TyClGroup GhcPs]
-- Rename the declarations and do dependency analysis on them
rnTyClDecls tycl_ds
= do { -- Rename the type/class, instance, and role declaraations
- tycls_w_fvs <- mapM (wrapLocFstM rnTyClDecl)
- (tyClGroupTyClDecls tycl_ds)
+ ; tycls_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (tyClGroupTyClDecls tycl_ds)
; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs)
-
+ ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names (tyClGroupKindSigs tycl_ds)
; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (tyClGroupInstDecls tycl_ds)
; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds)
-- Do SCC analysis on the type/class decls
; rdr_env <- getGlobalRdrEnv
- ; let tycl_sccs = depAnalTyClDecls rdr_env tycls_w_fvs
+ ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs
role_annot_env = mkRoleAnnotEnv role_annots
+ (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs
inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs
(init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map
@@ -1307,15 +1308,16 @@ rnTyClDecls tycl_ds
| null init_inst_ds = []
| otherwise = [TyClGroup { group_ext = noExtField
, group_tyclds = []
+ , group_kisigs = []
, group_roles = []
, group_instds = init_inst_ds }]
(final_inst_ds, groups)
- = mapAccumL (mk_group role_annot_env) rest_inst_ds tycl_sccs
-
+ = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs
- all_fvs = plusFV (foldr (plusFV . snd) emptyFVs tycls_w_fvs)
- (foldr (plusFV . snd) emptyFVs instds_w_fvs)
+ all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV`
+ foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV`
+ foldr (plusFV . snd) emptyFVs kisigs_w_fvs
all_groups = first_group ++ groups
@@ -1326,32 +1328,91 @@ rnTyClDecls tycl_ds
; return (all_groups, all_fvs) }
where
mk_group :: RoleAnnotEnv
+ -> KindSigEnv
-> InstDeclFreeVarsMap
-> SCC (LTyClDecl GhcRn)
-> (InstDeclFreeVarsMap, TyClGroup GhcRn)
- mk_group role_env inst_map scc
+ mk_group role_env kisig_env inst_map scc
= (inst_map', group)
where
tycl_ds = flattenSCC scc
bndrs = map (tcdName . unLoc) tycl_ds
roles = getRoleAnnots bndrs role_env
+ kisigs = getKindSigs bndrs kisig_env
(inst_ds, inst_map') = getInsts bndrs inst_map
group = TyClGroup { group_ext = noExtField
, group_tyclds = tycl_ds
+ , group_kisigs = kisigs
, group_roles = roles
, group_instds = inst_ds }
+-- | Free variables of standalone kind signatures.
+newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars)
+
+lookupKindSig_FV_Env :: KindSig_FV_Env -> Name -> FreeVars
+lookupKindSig_FV_Env (KindSig_FV_Env e) name
+ = fromMaybe emptyFVs (lookupNameEnv e name)
+
+-- | Standalone kind signatures.
+type KindSigEnv = NameEnv (LStandaloneKindSig GhcRn)
+
+mkKindSig_fv_env :: [(LStandaloneKindSig GhcRn, FreeVars)] -> (KindSigEnv, KindSig_FV_Env)
+mkKindSig_fv_env kisigs_w_fvs = (kisig_env, kisig_fv_env)
+ where
+ kisig_env = mapNameEnv fst compound_env
+ kisig_fv_env = KindSig_FV_Env (mapNameEnv snd compound_env)
+ compound_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars)
+ = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs
+
+getKindSigs :: [Name] -> KindSigEnv -> [LStandaloneKindSig GhcRn]
+getKindSigs bndrs kisig_env = mapMaybe (lookupNameEnv kisig_env) bndrs
+
+rnStandaloneKindSignatures
+ :: NameSet -- names of types and classes in the current TyClGroup
+ -> [LStandaloneKindSig GhcPs]
+ -> RnM [(LStandaloneKindSig GhcRn, FreeVars)]
+rnStandaloneKindSignatures tc_names kisigs
+ = do { let (no_dups, dup_kisigs) = removeDups (compare `on` get_name) kisigs
+ get_name = standaloneKindSigName . unLoc
+ ; mapM_ dupKindSig_Err dup_kisigs
+ ; mapM (wrapLocFstM (rnStandaloneKindSignature tc_names)) no_dups
+ }
+
+rnStandaloneKindSignature
+ :: NameSet -- names of types and classes in the current TyClGroup
+ -> StandaloneKindSig GhcPs
+ -> RnM (StandaloneKindSig GhcRn, FreeVars)
+rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki)
+ = do { standalone_ki_sig_ok <- xoptM LangExt.StandaloneKindSignatures
+ ; unless standalone_ki_sig_ok $ addErr standaloneKiSigErr
+ ; new_v <- lookupSigCtxtOccRn (TopSigCtxt tc_names) (text "standalone kind signature") v
+ ; let doc = StandaloneKindSigCtx (ppr v)
+ ; (new_ki, fvs) <- rnHsSigType doc KindLevel ki
+ ; return (StandaloneKindSig noExtField new_v new_ki, fvs)
+ }
+ where
+ standaloneKiSigErr :: SDoc
+ standaloneKiSigErr =
+ hang (text "Illegal standalone kind signature")
+ 2 (text "Did you mean to enable StandaloneKindSignatures?")
+rnStandaloneKindSignature _ (XStandaloneKindSig nec) = noExtCon nec
depAnalTyClDecls :: GlobalRdrEnv
+ -> KindSig_FV_Env
-> [(LTyClDecl GhcRn, FreeVars)]
-> [SCC (LTyClDecl GhcRn)]
-- See Note [Dependency analysis of type, class, and instance decls]
-depAnalTyClDecls rdr_env ds_w_fvs
+depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
= stronglyConnCompFromEdgedVerticesUniq edges
where
edges :: [ Node Name (LTyClDecl GhcRn) ]
- edges = [ DigraphNode d (tcdName (unLoc d)) (map (getParent rdr_env) (nonDetEltsUniqSet fvs))
- | (d, fvs) <- ds_w_fvs ]
+ edges = [ DigraphNode d name (map (getParent rdr_env) (nonDetEltsUniqSet deps))
+ | (d, fvs) <- ds_w_fvs,
+ let { name = tcdName (unLoc d)
+ ; kisig_fvs = lookupKindSig_FV_Env kisig_fv_env name
+ ; deps = fvs `plusFV` kisig_fvs
+ }
+ ]
-- It's OK to use nonDetEltsUFM here as
-- stronglyConnCompFromEdgedVertices is still deterministic
-- even if the edges are in nondeterministic order as explained
@@ -1391,9 +1452,8 @@ rnRoleAnnots :: NameSet
rnRoleAnnots tc_names role_annots
= do { -- Check for duplicates *before* renaming, to avoid
-- lumping together all the unboundNames
- let (no_dups, dup_annots) = removeDups role_annots_cmp role_annots
- role_annots_cmp (dL->L _ annot1) (dL->L _ annot2)
- = roleAnnotDeclName annot1 `compare` roleAnnotDeclName annot2
+ let (no_dups, dup_annots) = removeDups (compare `on` get_name) role_annots
+ get_name = roleAnnotDeclName . unLoc
; mapM_ dupRoleAnnotErr dup_annots
; mapM (wrapLocM rn_role_annot1) no_dups }
where
@@ -1421,6 +1481,20 @@ dupRoleAnnotErr list
cmp_annot (dL->L loc1 _) (dL->L loc2 _) = loc1 `compare` loc2
+dupKindSig_Err :: NonEmpty (LStandaloneKindSig GhcPs) -> RnM ()
+dupKindSig_Err list
+ = addErrAt loc $
+ hang (text "Duplicate standalone kind signatures for" <+>
+ quotes (ppr $ standaloneKindSigName first_decl) <> colon)
+ 2 (vcat $ map pp_kisig $ NE.toList sorted_list)
+ where
+ sorted_list = NE.sortBy cmp_loc list
+ ((dL->L loc first_decl) :| _) = sorted_list
+
+ pp_kisig (dL->L loc decl) =
+ hang (ppr decl) 4 (text "-- written at" <+> ppr loc)
+
+ cmp_loc (dL->L loc1 _) (dL->L loc2 _) = loc1 `compare` loc2
{- Note [Role annotations in the renamer]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1495,12 +1569,11 @@ getInsts bndrs inst_decl_map
rnTyClDecl :: TyClDecl GhcPs
-> RnM (TyClDecl GhcRn, FreeVars)
--- All flavours of type family declarations ("type family", "newtype family",
--- and "data family"), both top level and (for an associated type)
--- in a class decl
-rnTyClDecl (FamDecl { tcdFam = decl })
- = do { (decl', fvs) <- rnFamDecl Nothing decl
- ; return (FamDecl noExtField decl', fvs) }
+-- All flavours of top-level type family declarations ("type family", "newtype
+-- family", and "data family")
+rnTyClDecl (FamDecl { tcdFam = fam })
+ = do { (fam', fvs) <- rnFamDecl Nothing fam
+ ; return (FamDecl noExtField fam', fvs) }
rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
tcdFixity = fixity, tcdRhs = rhs })
@@ -1515,9 +1588,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
, tcdRhs = rhs', tcdSExt = fvs }, fvs) } }
-- "data", "newtype" declarations
--- both top level and (for an associated type) in an instance decl
-rnTyClDecl (DataDecl _ _ _ _ (XHsDataDefn _)) =
- panic "rnTyClDecl: DataDecl with XHsDataDefn"
+rnTyClDecl (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec
rnTyClDecl (DataDecl
{ tcdLName = tycon, tcdTyVars = tyvars,
tcdFixity = fixity,
@@ -1529,8 +1600,7 @@ rnTyClDecl (DataDecl
; traceRn "rntycl-data" (ppr tycon <+> ppr kvs)
; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs ->
do { (defn', fvs) <- rnDataDefn doc defn
- ; cusk <- dataDeclHasCUSK
- tyvars' new_or_data no_rhs_kvs (isJust kind_sig)
+ ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig
; let rn_info = DataDeclRn { tcdDataCusk = cusk
, tcdFVs = fvs }
; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs)
@@ -1608,19 +1678,17 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
rnTyClDecl (XTyClDecl nec) = noExtCon nec
-- Does the data type declaration include a CUSK?
-dataDeclHasCUSK :: LHsQTyVars pass -> NewOrData -> Bool -> Bool -> RnM Bool
-dataDeclHasCUSK tyvars new_or_data no_rhs_kvs has_kind_sig = do
+data_decl_has_cusk :: LHsQTyVars pass -> NewOrData -> Bool -> Maybe (LHsKind pass') -> RnM Bool
+data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do
{ -- See Note [Unlifted Newtypes and CUSKs], and for a broader
-- picture, see Note [Implementation of UnliftedNewtypes].
; unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
; let non_cusk_newtype
| NewType <- new_or_data =
- unlifted_newtypes && not has_kind_sig
+ unlifted_newtypes && isNothing kind_sig
| otherwise = False
-- See Note [CUSKs: complete user-supplied kind signatures] in GHC.Hs.Decls
- ; cusks_enabled <- xoptM LangExt.CUSKs
- ; return $ cusks_enabled && hsTvbAllKinded tyvars &&
- no_rhs_kvs && not non_cusk_newtype
+ ; return $ hsTvbAllKinded tyvars && no_rhs_kvs && not non_cusk_newtype
}
{- Note [Unlifted Newtypes and CUSKs]
@@ -1724,7 +1792,7 @@ rnLHsDerivingClause doc
, deriv_clause_strategy = dcs
, deriv_clause_tys = (dL->L loc' dct) }))
= do { (dcs', dct', fvs)
- <- rnLDerivStrategy doc dcs $ mapFvRn (rnHsSigType doc) dct
+ <- rnLDerivStrategy doc dcs $ mapFvRn (rnHsSigType doc TypeLevel) dct
; warnNoDerivStrat dcs' loc
; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExtField
, deriv_clause_strategy = dcs'
@@ -1766,7 +1834,7 @@ rnLDerivStrategy doc mds thing_inside
AnyclassStrategy -> boring_case AnyclassStrategy
NewtypeStrategy -> boring_case NewtypeStrategy
ViaStrategy via_ty ->
- do (via_ty', fvs1) <- rnHsSigType doc via_ty
+ do (via_ty', fvs1) <- rnHsSigType doc TypeLevel via_ty
let HsIB { hsib_ext = via_imp_tvs
, hsib_body = via_body } = via_ty'
(via_exp_tv_bndrs, _, _) = splitLHsSigmaTy via_body
@@ -2249,6 +2317,11 @@ add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD _ d) ds
-- Signatures: fixity sigs go a different place than all others
add gp@(HsGroup {hs_fixds = ts}) l (SigD _ (FixSig _ f)) ds
= addl (gp {hs_fixds = cL l f : ts}) ds
+
+-- Standalone kind signatures: added to the TyClGroup
+add gp@(HsGroup {hs_tyclds = ts}) l (KindSigD _ s) ds
+ = addl (gp {hs_tyclds = add_kisig (cL l s) ts}) ds
+
add gp@(HsGroup {hs_valds = ts}) l (SigD _ d) ds
= addl (gp {hs_valds = add_sig (cL l d) ts}) ds
@@ -2289,6 +2362,7 @@ add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
add_tycld d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = [d]
+ , group_kisigs = []
, group_roles = []
, group_instds = []
}
@@ -2301,6 +2375,7 @@ add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
add_instd d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = []
+ , group_kisigs = []
, group_roles = []
, group_instds = [d]
}
@@ -2313,6 +2388,7 @@ add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
add_role_annot d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = []
+ , group_kisigs = []
, group_roles = [d]
, group_instds = []
}
@@ -2321,6 +2397,19 @@ add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)
= tycls { group_roles = d : roles } : rest
add_role_annot _ (XTyClGroup nec: _) = noExtCon nec
+add_kisig :: LStandaloneKindSig (GhcPass p)
+ -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)]
+add_kisig d [] = [TyClGroup { group_ext = noExtField
+ , group_tyclds = []
+ , group_kisigs = [d]
+ , group_roles = []
+ , group_instds = []
+ }
+ ]
+add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest)
+ = tycls { group_kisigs = d : kisigs } : rest
+add_kisig _ (XTyClGroup nec : _) = noExtCon nec
+
add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs
add_bind _ (XValBindsLR {}) = panic "RdrHsSyn:add_bind"
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index e982e72f82..5f0a1c62c7 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -242,6 +242,7 @@ extraConstraintWildCardsAllowed env
TypeSigCtx {} -> True
ExprWithTySigCtx {} -> True
DerivDeclCtx {} -> True
+ StandaloneKindSigCtx {} -> False -- See Note [Wildcards in standalone kind signatures] in GHC/Hs/Decls
_ -> False
-- | Finds free type and kind variables in a type,
@@ -295,19 +296,22 @@ of the HsWildCardBndrs structure, and we are done.
* *
****************************************************** -}
-rnHsSigType :: HsDocContext -> LHsSigType GhcPs
+rnHsSigType :: HsDocContext
+ -> TypeOrKind
+ -> LHsSigType GhcPs
-> RnM (LHsSigType GhcRn, FreeVars)
-- Used for source-language type signatures
-- that cannot have wildcards
-rnHsSigType ctx (HsIB { hsib_body = hs_ty })
+rnHsSigType ctx level (HsIB { hsib_body = hs_ty })
= do { traceRn "rnHsSigType" (ppr hs_ty)
; vars <- extractFilteredRdrTyVarsDups hs_ty
; rnImplicitBndrs (not (isLHsForAllTy hs_ty)) vars $ \ vars ->
- do { (body', fvs) <- rnLHsType ctx hs_ty
+ do { (body', fvs) <- rnLHsTyKi (mkTyKiEnv ctx level RnTypeBody) hs_ty
+
; return ( HsIB { hsib_ext = vars
, hsib_body = body' }
, fvs ) } }
-rnHsSigType _ (XHsImplicitBndrs nec) = noExtCon nec
+rnHsSigType _ _ (XHsImplicitBndrs nec) = noExtCon nec
rnImplicitBndrs :: Bool -- True <=> bring into scope any free type variables
-- E.g. f :: forall a. a->b
@@ -563,9 +567,9 @@ rnHsTyKi env t@(HsKindSig _ ty k)
= do { checkPolyKinds env t
; kind_sigs_ok <- xoptM LangExt.KindSignatures
; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
- ; (ty', fvs1) <- rnLHsTyKi env ty
- ; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k
- ; return (HsKindSig noExtField ty' k', fvs1 `plusFV` fvs2) }
+ ; (ty', lhs_fvs) <- rnLHsTyKi env ty
+ ; (k', sig_fvs) <- rnLHsTyKi (env { rtke_level = KindLevel }) k
+ ; return (HsKindSig noExtField ty' k', lhs_fvs `plusFV` sig_fvs) }
-- Unboxed tuples are allowed to have poly-typed arguments. These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
@@ -734,6 +738,7 @@ wildCardsAllowed env
FamPatCtx {} -> True -- Not named wildcards though
GHCiCtx {} -> True
HsTypeCtx {} -> True
+ StandaloneKindSigCtx {} -> False -- See Note [Wildcards in standalone kind signatures] in GHC/Hs/Decls
_ -> False
diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs
index 6678ad6dbf..0da8e30f6a 100644
--- a/compiler/rename/RnUtils.hs
+++ b/compiler/rename/RnUtils.hs
@@ -458,6 +458,7 @@ checkTupSize tup_size
-- Merge TcType.UserTypeContext in to it.
data HsDocContext
= TypeSigCtx SDoc
+ | StandaloneKindSigCtx SDoc
| PatCtx
| SpecInstSigCtx
| DefaultDeclCtx
@@ -487,6 +488,7 @@ inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt
pprHsDocContext :: HsDocContext -> SDoc
pprHsDocContext (GenericCtx doc) = doc
pprHsDocContext (TypeSigCtx doc) = text "the type signature for" <+> doc
+pprHsDocContext (StandaloneKindSigCtx doc) = text "the standalone kind signature for" <+> doc
pprHsDocContext PatCtx = text "a pattern type-signature"
pprHsDocContext SpecInstSigCtx = text "a SPECIALISE instance pragma"
pprHsDocContext DefaultDeclCtx = text "a `default' declaration"
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index d2b32e7d7d..d74b38c9fd 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -195,6 +195,8 @@ both of them. So we gather defs/uses from deriving just like anything else.
data DerivInfo = DerivInfo { di_rep_tc :: TyCon
-- ^ The data tycon for normal datatypes,
-- or the *representation* tycon for data families
+ , di_scoped_tvs :: ![(Name,TyVar)]
+ -- ^ Variables that scope over the deriving clause.
, di_clauses :: [LHsDerivingClause GhcRn]
, di_ctxt :: SDoc -- ^ error context
}
@@ -493,8 +495,10 @@ makeDerivSpecs :: Bool
-> TcM [EarlyDerivSpec]
makeDerivSpecs is_boot deriv_infos deriv_decls
= do { eqns1 <- sequenceA
- [ deriveClause rep_tc dcs preds err_ctxt
- | DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
+ [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt
+ | DerivInfo { di_rep_tc = rep_tc
+ , di_scoped_tvs = scoped_tvs
+ , di_clauses = clauses
, di_ctxt = err_ctxt } <- deriv_infos
, L _ (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ preds })
@@ -515,17 +519,21 @@ makeDerivSpecs is_boot deriv_infos deriv_decls
------------------------------------------------------------------
-- | Process the derived classes in a single @deriving@ clause.
-deriveClause :: TyCon -> Maybe (LDerivStrategy GhcRn)
+deriveClause :: TyCon
+ -> [(Name, TcTyVar)] -- Scoped type variables taken from tcTyConScopedTyVars
+ -- See Note [Scoped tyvars in a TcTyCon] in types/TyCon
+ -> Maybe (LDerivStrategy GhcRn)
-> [LHsSigType GhcRn] -> SDoc
-> TcM [EarlyDerivSpec]
-deriveClause rep_tc mb_lderiv_strat deriv_preds err_ctxt
+deriveClause rep_tc scoped_tvs mb_lderiv_strat deriv_preds err_ctxt
= addErrCtxt err_ctxt $ do
traceTc "deriveClause" $ vcat
[ text "tvs" <+> ppr tvs
+ , text "scoped_tvs" <+> ppr scoped_tvs
, text "tc" <+> ppr tc
, text "tys" <+> ppr tys
, text "mb_lderiv_strat" <+> ppr mb_lderiv_strat ]
- tcExtendTyVarEnv tvs $ do
+ tcExtendNameTyVarEnv scoped_tvs $ do
(mb_lderiv_strat', via_tvs) <- tcDerivStrategy mb_lderiv_strat
tcExtendTyVarEnv via_tvs $
-- Moreover, when using DerivingVia one can bind type variables in
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index 3cc1994f5b..2d59dc191b 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -36,6 +36,7 @@ module TcEnv(
tcLookup, tcLookupLocated, tcLookupLocalIds,
tcLookupId, tcLookupIdMaybe, tcLookupTyVar,
+ tcLookupTcTyCon,
tcLookupLcl_maybe,
getInLocalScope,
wrongThingErr, pprBinders,
@@ -106,6 +107,7 @@ import ListSetOps
import ErrUtils
import Maybes( MaybeErr(..), orElse )
import qualified GHC.LanguageExtensions as LangExt
+import Util ( HasDebugCallStack )
import Data.IORef
import Data.List
@@ -443,6 +445,13 @@ tcLookupLocalIds ns
Just (ATcId { tct_id = id }) -> id
_ -> pprPanic "tcLookupLocalIds" (ppr name)
+tcLookupTcTyCon :: HasDebugCallStack => Name -> TcM TcTyCon
+tcLookupTcTyCon name = do
+ thing <- tcLookup name
+ case thing of
+ ATcTyCon tc -> return tc
+ _ -> pprPanic "tcLookupTcTyCon" (ppr name)
+
getInLocalScope :: TcM (Name -> Bool)
getInLocalScope = do { lcl_env <- getLclTypeEnv
; return (`elemNameEnv` lcl_env) }
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 37cc83e4ca..cd65fc0522 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE CPP, TupleSections, MultiWayIf, RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
@@ -15,6 +16,7 @@ module TcHsType (
kcClassSigType, tcClassSigType,
tcHsSigType, tcHsSigWcType,
tcHsPartialSigType,
+ tcStandaloneKindSig,
funsSigCtxt, addSigCtxt, pprSigCtxt,
tcHsClsInstType,
@@ -36,7 +38,9 @@ module TcHsType (
-- Kind-checking types
-- No kind generalisation, no checkValidType
- kcLHsQTyVars,
+ InitialKindStrategy(..),
+ SAKS_or_CUSK(..),
+ kcDeclHeader,
tcNamedWildCardBinders,
tcHsLiftedType, tcHsOpenType,
tcHsLiftedTypeNC, tcHsOpenTypeNC,
@@ -52,6 +56,7 @@ module TcHsType (
-- Sort-checking kinds
tcLHsKindSig, checkDataKindSig, DataSort(..),
+ checkClassKindSig,
-- Pattern type signatures
tcHsPatSigType, tcPatSig,
@@ -74,11 +79,10 @@ import TcUnify
import TcIface
import TcSimplify
import TcHsSyn
-import TyCoRep ( Type(..) )
+import TyCoRep
import TcErrors ( reportAllUnsolved )
import TcType
import Inst ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder )
-import TyCoRep( TyCoBinder(..) ) -- Used in etaExpandAlgTyCon
import Type
import TysPrim
import RdrName( lookupLocalRdrOcc )
@@ -241,6 +245,17 @@ tcHsSigType ctxt sig_ty
where
skol_info = SigTypeSkol ctxt
+-- Does validity checking and zonking.
+tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind)
+tcStandaloneKindSig (L _ kisig) = case kisig of
+ StandaloneKindSig _ (L _ name) ksig ->
+ let ctxt = StandaloneKindSigCtxt name in
+ addSigCtxt ctxt (hsSigType ksig) $
+ do { kind <- tcTopLHsType kindLevelMode ksig (expectedKindInCtxt ctxt)
+ ; checkValidType ctxt kind
+ ; return (name, kind) }
+ XStandaloneKindSig nec -> noExtCon nec
+
tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn
-> ContextKind -> TcM (Bool, TcType)
-- Kind-checks/desugars an 'LHsSigType',
@@ -279,13 +294,13 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind
tc_hs_sig_type _ (XHsImplicitBndrs nec) _ = noExtCon nec
-tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type
+tcTopLHsType :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type
-- tcTopLHsType is used for kind-checking top-level HsType where
-- we want to fully solve /all/ equalities, and report errors
-- Does zonking, but not validity checking because it's used
-- for things (like deriving and instances) that aren't
-- ordinary types
-tcTopLHsType hs_sig_type ctxt_kind
+tcTopLHsType mode hs_sig_type ctxt_kind
| HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type
= do { traceTc "tcTopLHsType {" (ppr hs_ty)
; (spec_tkvs, ty)
@@ -293,7 +308,7 @@ tcTopLHsType hs_sig_type ctxt_kind
solveEqualities $
bindImplicitTKBndrs_Skol sig_vars $
do { kind <- newExpectedKind ctxt_kind
- ; tc_lhs_type typeLevelMode hs_ty kind }
+ ; tc_lhs_type mode hs_ty kind }
; spec_tkvs <- zonkAndScopedSort spec_tkvs
; let ty1 = mkSpecForAllTys spec_tkvs ty
@@ -302,7 +317,7 @@ tcTopLHsType hs_sig_type ctxt_kind
; traceTc "End tcTopLHsType }" (vcat [ppr hs_ty, ppr final_ty])
; return final_ty}
-tcTopLHsType (XHsImplicitBndrs nec) _ = noExtCon nec
+tcTopLHsType _ (XHsImplicitBndrs nec) _ = noExtCon nec
-----------------
tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind])
@@ -315,7 +330,7 @@ tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind])
tcHsDeriv hs_ty
= do { ty <- checkNoErrs $ -- Avoid redundant error report
-- with "illegal deriving", below
- tcTopLHsType hs_ty AnyKind
+ tcTopLHsType typeLevelMode hs_ty AnyKind
; let (tvs, pred) = splitForAllTys ty
(kind_args, _) = splitFunTys (tcTypeKind pred)
; case getClassPredTys_maybe pred of
@@ -344,7 +359,7 @@ tcDerivStrategy mb_lds
tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy
tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy
tc_deriv_strategy (ViaStrategy ty) = do
- ty' <- checkNoErrs $ tcTopLHsType ty AnyKind
+ ty' <- checkNoErrs $ tcTopLHsType typeLevelMode ty AnyKind
let (via_tvs, via_pred) = splitForAllTys ty'
pure (ViaStrategy via_pred, via_tvs)
@@ -362,7 +377,7 @@ tcHsClsInstType user_ctxt hs_inst_ty
-- eagerly avoids follow-on errors when checkValidInstance
-- sees an unsolved coercion hole
inst_ty <- checkNoErrs $
- tcTopLHsType hs_inst_ty (TheKind constraintKind)
+ tcTopLHsType typeLevelMode hs_inst_ty (TheKind constraintKind)
; checkValidInstance user_ctxt hs_inst_ty inst_ty
; return inst_ty }
@@ -1776,57 +1791,68 @@ newWildTyVar
* *
********************************************************************* -}
-{- Note [The initial kind of a type constructor]
+-- See Note [kcCheckDeclHeader vs kcInferDeclHeader]
+data InitialKindStrategy
+ = InitialKindCheck SAKS_or_CUSK
+ | InitialKindInfer
+
+-- Does the declaration have a standalone kind signature (SAKS) or a complete
+-- user-specified kind (CUSK)?
+data SAKS_or_CUSK
+ = SAKS Kind -- Standalone kind signature, fully zonked! (zonkTcTypeToType)
+ | CUSK -- Complete user-specified kind (CUSK)
+
+instance Outputable SAKS_or_CUSK where
+ ppr (SAKS k) = text "SAKS" <+> ppr k
+ ppr CUSK = text "CUSK"
+
+-- See Note [kcCheckDeclHeader vs kcInferDeclHeader]
+kcDeclHeader
+ :: InitialKindStrategy
+ -> Name -- ^ of the thing being checked
+ -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
+ -> LHsQTyVars GhcRn -- ^ Binders in the header
+ -> TcM ContextKind -- ^ The result kind
+ -> TcM TcTyCon -- ^ A suitably-kinded TcTyCon
+kcDeclHeader (InitialKindCheck msig) = kcCheckDeclHeader msig
+kcDeclHeader InitialKindInfer = kcInferDeclHeader
+
+{- Note [kcCheckDeclHeader vs kcInferDeclHeader]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-kcLHsQTyVars is responsible for getting the initial kind of
-a type constructor.
-
-It has two cases:
-
- * The TyCon has a CUSK. In that case, find the full, final,
- poly-kinded kind of the TyCon. It's very like a term-level
- binding where we have a complete type signature for the
- function.
-
- * It does not have a CUSK. Find a monomorphic kind, with
- unification variables in it; they will be generalised later.
- It's very like a term-level binding where we do not have
- a type signature (or, more accurately, where we have a
- partial type signature), so we infer the type and generalise.
+kcCheckDeclHeader and kcInferDeclHeader are responsible for getting the initial kind
+of a type constructor.
+
+* kcCheckDeclHeader: the TyCon has a standalone kind signature or a CUSK. In that
+ case, find the full, final, poly-kinded kind of the TyCon. It's very like a
+ term-level binding where we have a complete type signature for the function.
+
+* kcInferDeclHeader: the TyCon has neither a standalone kind signature nor a
+ CUSK. Find a monomorphic kind, with unification variables in it; they will be
+ generalised later. It's very like a term-level binding where we do not have a
+ type signature (or, more accurately, where we have a partial type signature),
+ so we infer the type and generalise.
-}
-
-------------------------------
--- | Kind-check a 'LHsQTyVars'. If the decl under consideration has a complete,
--- user-supplied kind signature (CUSK), generalise the result.
--- Used in 'getInitialKind' (for tycon kinds and other kinds)
--- and in kind-checking (but not for tycon kinds, which are checked with
--- tcTyClDecls). See Note [CUSKs: complete user-supplied kind signatures]
--- in GHC.Hs.Decls.
---
--- This function does not do telescope checking.
-kcLHsQTyVars :: Name -- ^ of the thing being checked
- -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
- -> Bool -- ^ True <=> the decl being checked has a CUSK
- -> LHsQTyVars GhcRn
- -> TcM Kind -- ^ The result kind
- -> TcM TcTyCon -- ^ A suitably-kinded TcTyCon
-kcLHsQTyVars name flav cusk tvs thing_inside
- | cusk = kcLHsQTyVars_Cusk name flav tvs thing_inside
- | otherwise = kcLHsQTyVars_NonCusk name flav tvs thing_inside
-
-
-kcLHsQTyVars_Cusk, kcLHsQTyVars_NonCusk
- :: Name -- ^ of the thing being checked
- -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
- -> LHsQTyVars GhcRn
- -> TcM Kind -- ^ The result kind
- -> TcM TcTyCon -- ^ A suitably-kinded TcTyCon
-
------------------------------
-kcLHsQTyVars_Cusk name flav
+kcCheckDeclHeader
+ :: SAKS_or_CUSK
+ -> Name -- ^ of the thing being checked
+ -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
+ -> LHsQTyVars GhcRn -- ^ Binders in the header
+ -> TcM ContextKind -- ^ The result kind. AnyKind == no result signature
+ -> TcM TcTyCon -- ^ A suitably-kinded generalized TcTyCon
+kcCheckDeclHeader (SAKS sig) = kcCheckDeclHeader_sig sig
+kcCheckDeclHeader CUSK = kcCheckDeclHeader_cusk
+
+kcCheckDeclHeader_cusk
+ :: Name -- ^ of the thing being checked
+ -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
+ -> LHsQTyVars GhcRn -- ^ Binders in the header
+ -> TcM ContextKind -- ^ The result kind
+ -> TcM TcTyCon -- ^ A suitably-kinded generalized TcTyCon
+kcCheckDeclHeader_cusk name flav
(HsQTvs { hsq_ext = kv_ns
- , hsq_explicit = hs_tvs }) thing_inside
+ , hsq_explicit = hs_tvs }) kc_res_ki
-- CUSK case
-- See note [Required, Specified, and Inferred for types] in TcTyClsDecls
= addTyConFlavCtxt name flav $
@@ -1835,19 +1861,21 @@ kcLHsQTyVars_Cusk name flav
solveEqualities $
bindImplicitTKBndrs_Q_Skol kv_ns $
bindExplicitTKBndrs_Q_Skol ctxt_kind hs_tvs $
- thing_inside
+ newExpectedKind =<< kc_res_ki
-- Now, because we're in a CUSK,
-- we quantify over the mentioned kind vars
; let spec_req_tkvs = scoped_kvs ++ tc_tvs
all_kinds = res_kind : map tyVarKind spec_req_tkvs
- ; candidates <- candidateQTyVarsOfKinds all_kinds
+ ; candidates' <- candidateQTyVarsOfKinds all_kinds
-- 'candidates' are all the variables that we are going to
-- skolemise and then quantify over. We do not include spec_req_tvs
-- because they are /already/ skolems
- ; let inf_candidates = candidates `delCandidates` spec_req_tkvs
+ ; let non_tc_candidates = filter (not . isTcTyVar) (nonDetEltsUniqSet (tyCoVarsOfTypes all_kinds))
+ candidates = candidates' { dv_kvs = dv_kvs candidates' `extendDVarSetList` non_tc_candidates }
+ inf_candidates = candidates `delCandidates` spec_req_tkvs
; inferred <- quantifyTyVars inf_candidates
-- NB: 'inferred' comes back sorted in dependency order
@@ -1866,13 +1894,14 @@ kcLHsQTyVars_Cusk name flav
all_tv_prs = mkTyVarNamePairs (scoped_kvs ++ tc_tvs)
tycon = mkTcTyCon name final_tc_binders res_kind all_tv_prs
- True {- it is generalised -} flav
+ True -- it is generalised
+ flav
-- If the ordering from
-- Note [Required, Specified, and Inferred for types] in TcTyClsDecls
-- doesn't work, we catch it here, before an error cascade
; checkTyConTelescope tycon
- ; traceTc "kcLHsQTyVars: cusk" $
+ ; traceTc "kcCheckDeclHeader_cusk " $
vcat [ text "name" <+> ppr name
, text "kv_ns" <+> ppr kv_ns
, text "hs_tvs" <+> ppr hs_tvs
@@ -1891,21 +1920,29 @@ kcLHsQTyVars_Cusk name flav
where
ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind
| otherwise = AnyKind
+kcCheckDeclHeader_cusk _ _ (XLHsQTyVars nec) _ = noExtCon nec
-kcLHsQTyVars_Cusk _ _ (XLHsQTyVars nec) _ = noExtCon nec
-
-------------------------------
-kcLHsQTyVars_NonCusk name flav
+-- | Kind-check a 'LHsQTyVars'. Used in 'inferInitialKind' (for tycon kinds and
+-- other kinds).
+--
+-- This function does not do telescope checking.
+kcInferDeclHeader
+ :: Name -- ^ of the thing being checked
+ -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
+ -> LHsQTyVars GhcRn
+ -> TcM ContextKind -- ^ The result kind
+ -> TcM TcTyCon -- ^ A suitably-kinded non-generalized TcTyCon
+kcInferDeclHeader name flav
(HsQTvs { hsq_ext = kv_ns
- , hsq_explicit = hs_tvs }) thing_inside
- -- Non_CUSK case
+ , hsq_explicit = hs_tvs }) kc_res_ki
+ -- No standalane kind signature and no CUSK.
-- See note [Required, Specified, and Inferred for types] in TcTyClsDecls
= do { (scoped_kvs, (tc_tvs, res_kind))
-- Why bindImplicitTKBndrs_Q_Tv which uses newTyVarTyVar?
-- See Note [Inferring kinds for type declarations] in TcTyClsDecls
<- bindImplicitTKBndrs_Q_Tv kv_ns $
bindExplicitTKBndrs_Q_Tv ctxt_kind hs_tvs $
- thing_inside
+ newExpectedKind =<< kc_res_ki
-- Why "_Tv" not "_Skol"? See third wrinkle in
-- Note [Inferring kinds for type declarations] in TcTyClsDecls,
@@ -1931,7 +1968,7 @@ kcLHsQTyVars_NonCusk name flav
False -- not yet generalised
flav
- ; traceTc "kcLHsQTyVars: not-cusk" $
+ ; traceTc "kcInferDeclHeader: not-cusk" $
vcat [ ppr name, ppr kv_ns, ppr hs_tvs
, ppr scoped_kvs
, ppr tc_tvs, ppr (mkTyConKind tc_binders res_kind) ]
@@ -1940,8 +1977,414 @@ kcLHsQTyVars_NonCusk name flav
ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind
| otherwise = AnyKind
-kcLHsQTyVars_NonCusk _ _ (XLHsQTyVars nec) _ = noExtCon nec
+kcInferDeclHeader _ _ (XLHsQTyVars nec) _ = noExtCon nec
+
+-- | Kind-check a declaration header against a standalone kind signature.
+-- See Note [Arity inference in kcCheckDeclHeader_sig]
+kcCheckDeclHeader_sig
+ :: Kind -- ^ Standalone kind signature, fully zonked! (zonkTcTypeToType)
+ -> Name -- ^ of the thing being checked
+ -> TyConFlavour -- ^ What sort of 'TyCon' is being checked
+ -> LHsQTyVars GhcRn -- ^ Binders in the header
+ -> TcM ContextKind -- ^ The result kind. AnyKind == no result signature
+ -> TcM TcTyCon -- ^ A suitably-kinded TcTyCon
+kcCheckDeclHeader_sig kisig name flav ktvs kc_res_ki =
+ addTyConFlavCtxt name flav $
+ pushTcLevelM_ $
+ solveEqualities $ -- #16687
+ bind_implicit (hsq_ext ktvs) $ \implicit_tcv_prs -> do
+
+ -- Step 1: zip user-written binders with quantifiers from the kind signature.
+ -- For example:
+ --
+ -- type F :: forall k -> k -> forall j. j -> Type
+ -- data F i a b = ...
+ --
+ -- Results in the following 'zipped_binders':
+ --
+ -- TyBinder LHsTyVarBndr
+ -- ---------------------------------------
+ -- ZippedBinder forall k -> i
+ -- ZippedBinder k -> a
+ -- ZippedBinder forall j.
+ -- ZippedBinder j -> b
+ --
+ let (zipped_binders, excess_bndrs, kisig') = zipBinders kisig (hsq_explicit ktvs)
+
+ -- Report binders that don't have a corresponding quantifier.
+ -- For example:
+ --
+ -- type T :: Type -> Type
+ -- data T b1 b2 b3 = ...
+ --
+ -- Here, b1 is zipped with Type->, while b2 and b3 are excess binders.
+ --
+ unless (null excess_bndrs) $ failWithTc (tooManyBindersErr kisig' excess_bndrs)
+
+ -- Convert each ZippedBinder to TyConBinder for tyConBinders
+ -- and to [(Name, TcTyVar)] for tcTyConScopedTyVars
+ (vis_tcbs, concat -> explicit_tv_prs) <- mapAndUnzipM zipped_to_tcb zipped_binders
+
+ tcExtendNameTyVarEnv explicit_tv_prs $ do
+
+ -- Check that inline kind annotations on binders are valid.
+ -- For example:
+ --
+ -- type T :: Maybe k -> Type
+ -- data T (a :: Maybe j) = ...
+ --
+ -- Here we unify Maybe k ~ Maybe j
+ mapM_ check_zipped_binder zipped_binders
+
+ -- Kind-check the result kind annotation, if present:
+ --
+ -- data T a b :: res_ki where
+ -- ^^^^^^^^^
+ -- We do it here because at this point the environment has been
+ -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'.
+ m_res_ki <- kc_res_ki >>= \ctx_k ->
+ case ctx_k of
+ AnyKind -> return Nothing
+ _ -> Just <$> newExpectedKind ctx_k
+
+ -- Step 2: split off invisible binders.
+ -- For example:
+ --
+ -- type F :: forall k1 k2. (k1, k2) -> Type
+ -- type family F
+ --
+ -- Does 'forall k1 k2' become a part of 'tyConBinders' or 'tyConResKind'?
+ -- See Note [Arity inference in kcCheckDeclHeader_sig]
+ let (invis_binders, r_ki) = split_invis kisig' m_res_ki
+
+ -- Convert each invisible TyCoBinder to TyConBinder for tyConBinders.
+ invis_tcbs <- mapM invis_to_tcb invis_binders
+
+ -- Check that the inline result kind annotation is valid.
+ -- For example:
+ --
+ -- type T :: Type -> Maybe k
+ -- type family T a :: Maybe j where
+ --
+ -- Here we unify Maybe k ~ Maybe j
+ whenIsJust m_res_ki $ \res_ki ->
+ discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig]
+ unifyKind Nothing r_ki res_ki
+
+ -- Zonk the implicitly quantified variables.
+ implicit_tv_prs <- mapSndM zonkTcTyVarToTyVar implicit_tcv_prs
+
+ -- Build the final, generalized TcTyCon
+ let tcbs = vis_tcbs ++ invis_tcbs
+ all_tv_prs = implicit_tv_prs ++ explicit_tv_prs
+ tc = mkTcTyCon name tcbs r_ki all_tv_prs True flav
+
+ traceTc "kcCheckDeclHeader_sig done:" $ vcat
+ [ text "tyConName = " <+> ppr (tyConName tc)
+ , text "kisig =" <+> debugPprType kisig
+ , text "tyConKind =" <+> debugPprType (tyConKind tc)
+ , text "tyConBinders = " <+> ppr (tyConBinders tc)
+ , text "tcTyConScopedTyVars" <+> ppr (tcTyConScopedTyVars tc)
+ , text "tyConResKind" <+> debugPprType (tyConResKind tc)
+ ]
+ return tc
+ where
+ -- Consider this declaration:
+ --
+ -- type T :: forall a. forall b -> (a~b) => Proxy a -> Type
+ -- data T x p = MkT
+ --
+ -- Here, we have every possible variant of ZippedBinder:
+ --
+ -- TyBinder LHsTyVarBndr
+ -- ----------------------------------------------
+ -- ZippedBinder forall {k}.
+ -- ZippedBinder forall (a::k).
+ -- ZippedBinder forall (b::k) -> x
+ -- ZippedBinder (a~b) =>
+ -- ZippedBinder Proxy a -> p
+ --
+ -- Given a ZippedBinder zipped_to_tcb produces:
+ --
+ -- * TyConBinder for tyConBinders
+ -- * (Name, TcTyVar) for tcTyConScopedTyVars, if there's a user-written LHsTyVarBndr
+ --
+ zipped_to_tcb :: ZippedBinder -> TcM (TyConBinder, [(Name, TcTyVar)])
+ zipped_to_tcb zb = case zb of
+
+ -- Inferred variable, no user-written binder.
+ -- Example: forall {k}.
+ ZippedBinder (Named (Bndr v Specified)) Nothing ->
+ return (mkNamedTyConBinder Specified v, [])
+
+ -- Specified variable, no user-written binder.
+ -- Example: forall (a::k).
+ ZippedBinder (Named (Bndr v Inferred)) Nothing ->
+ return (mkNamedTyConBinder Inferred v, [])
+
+ -- Constraint, no user-written binder.
+ -- Example: (a~b) =>
+ ZippedBinder (Anon InvisArg bndr_ki) Nothing -> do
+ name <- newSysName (mkTyVarOccFS (fsLit "ev"))
+ let tv = mkTyVar name bndr_ki
+ return (mkAnonTyConBinder InvisArg tv, [])
+
+ -- Non-dependent visible argument with a user-written binder.
+ -- Example: Proxy a ->
+ ZippedBinder (Anon VisArg bndr_ki) (Just b) ->
+ return $
+ let v_name = getName b
+ tv = mkTyVar v_name bndr_ki
+ tcb = mkAnonTyConBinder VisArg tv
+ in (tcb, [(v_name, tv)])
+
+ -- Dependent visible argument with a user-written binder.
+ -- Example: forall (b::k) ->
+ ZippedBinder (Named (Bndr v Required)) (Just b) ->
+ return $
+ let v_name = getName b
+ tcb = mkNamedTyConBinder Required v
+ in (tcb, [(v_name, v)])
+
+ -- 'zipBinders' does not produce any other variants of ZippedBinder.
+ _ -> panic "goVis: invalid ZippedBinder"
+
+ -- Given an invisible binder that comes from 'split_invis',
+ -- convert it to TyConBinder.
+ invis_to_tcb :: TyCoBinder -> TcM TyConBinder
+ invis_to_tcb tb = do
+ (tcb, stv) <- zipped_to_tcb (ZippedBinder tb Nothing)
+ MASSERT(null stv)
+ return tcb
+
+ -- similar to: bindImplicitTKBndrs_Tv
+ bind_implicit :: [Name] -> ([(Name,TcTyVar)] -> TcM a) -> TcM a
+ bind_implicit tv_names thing_inside =
+ do { let new_tv name = do { tcv <- newFlexiKindedTyVarTyVar name
+ ; return (name, tcv) }
+ ; tcvs <- mapM new_tv tv_names
+ ; tcExtendNameTyVarEnv tcvs (thing_inside tcvs) }
+
+ -- Check that the inline kind annotation on a binder is valid
+ -- by unifying it with the kind of the quantifier.
+ check_zipped_binder :: ZippedBinder -> TcM ()
+ check_zipped_binder (ZippedBinder _ Nothing) = return ()
+ check_zipped_binder (ZippedBinder tb (Just b)) =
+ case unLoc b of
+ UserTyVar _ _ -> return ()
+ KindedTyVar _ v v_hs_ki -> do
+ v_ki <- tcLHsKindSig (TyVarBndrKindCtxt (unLoc v)) v_hs_ki
+ discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig]
+ unifyKind (Just (HsTyVar noExtField NotPromoted v))
+ (tyBinderType tb)
+ v_ki
+ XTyVarBndr nec -> noExtCon nec
+
+ -- Split the invisible binders that should become a part of 'tyConBinders'
+ -- rather than 'tyConResKind'.
+ -- See Note [Arity inference in kcCheckDeclHeader_sig]
+ split_invis :: Kind -> Maybe Kind -> ([TyCoBinder], Kind)
+ split_invis sig_ki Nothing =
+ -- instantiate all invisible binders
+ splitPiTysInvisible sig_ki
+ split_invis sig_ki (Just res_ki) =
+ -- subtraction a la checkExpectedKind
+ let n_res_invis_bndrs = invisibleTyBndrCount res_ki
+ n_sig_invis_bndrs = invisibleTyBndrCount sig_ki
+ n_inst = n_sig_invis_bndrs - n_res_invis_bndrs
+ in splitPiTysInvisibleN n_inst sig_ki
+
+-- A quantifier from a kind signature zipped with a user-written binder for it.
+data ZippedBinder =
+ ZippedBinder TyBinder (Maybe (LHsTyVarBndr GhcRn))
+
+-- See Note [Arity inference in kcCheckDeclHeader_sig]
+zipBinders
+ :: Kind -- kind signature
+ -> [LHsTyVarBndr GhcRn] -- user-written binders
+ -> ([ZippedBinder], -- zipped binders
+ [LHsTyVarBndr GhcRn], -- remaining user-written binders
+ Kind) -- remainder of the kind signature
+zipBinders = zip_binders []
+ where
+ zip_binders acc ki [] = (reverse acc, [], ki)
+ zip_binders acc ki (b:bs) =
+ case tcSplitPiTy_maybe ki of
+ Nothing -> (reverse acc, b:bs, ki)
+ Just (tb, ki') ->
+ let
+ (zb, bs') | zippable = (ZippedBinder tb (Just b), bs)
+ | otherwise = (ZippedBinder tb Nothing, b:bs)
+ zippable =
+ case tb of
+ Named (Bndr _ Specified) -> False
+ Named (Bndr _ Inferred) -> False
+ Named (Bndr _ Required) -> True
+ Anon InvisArg _ -> False
+ Anon VisArg _ -> True
+ in
+ zip_binders (zb:acc) ki' bs'
+
+tooManyBindersErr :: Kind -> [LHsTyVarBndr GhcRn] -> SDoc
+tooManyBindersErr ki bndrs =
+ hang (text "Not a function kind:")
+ 4 (ppr ki) $$
+ hang (text "but extra binders found:")
+ 4 (fsep (map ppr bndrs))
+
+{- Note [Arity inference in kcCheckDeclHeader_sig]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Given a kind signature 'kisig' and a declaration header, kcCheckDeclHeader_sig
+verifies that the declaration conforms to the signature. The end result is a
+TcTyCon 'tc' such that:
+
+ tyConKind tc == kisig
+
+This TcTyCon would be rather easy to produce if we didn't have to worry about
+arity. Consider these declarations:
+
+ type family S1 :: forall k. k -> Type
+ type family S2 (a :: k) :: Type
+
+Both S1 and S2 can be given the same standalone kind signature:
+
+ type S2 :: forall k. k -> Type
+
+And, indeed, tyConKind S1 == tyConKind S2. However, tyConKind is built from
+tyConBinders and tyConResKind, such that
+
+ tyConKind tc == mkTyConKind (tyConBinders tc) (tyConResKind tc)
+
+For S1 and S2, tyConBinders and tyConResKind are different:
+
+ tyConBinders S1 == []
+ tyConResKind S1 == forall k. k -> Type
+ tyConKind S1 == forall k. k -> Type
+
+ tyConBinders S2 == [spec k, anon-vis (a :: k)]
+ tyConResKind S2 == Type
+ tyConKind S1 == forall k. k -> Type
+
+This difference determines the arity:
+
+ tyConArity tc == length (tyConBinders tc)
+
+That is, the arity of S1 is 0, while the arity of S2 is 2.
+
+'kcCheckDeclHeader_sig' needs to infer the desired arity to split the standalone
+kind signature into binders and the result kind. It does so in two rounds:
+1. zip user-written binders (vis_tcbs)
+2. split off invisible binders (invis_tcbs)
+
+Consider the following declarations:
+
+ type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type
+ type family F a b
+
+ type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type
+ type family G a b :: forall r2. (r1, r2) -> Type
+
+In step 1 (zip user-written binders), we zip the quantifiers in the signature
+with the binders in the header using 'zipBinders'. In both F and G, this results in
+the following zipped binders:
+
+ TyBinder LHsTyVarBndr
+ ---------------------------------------
+ ZippedBinder Type -> a
+ ZippedBinder forall j.
+ ZippedBinder j -> b
+
+
+At this point, we have accumulated three zipped binders which correspond to a
+prefix of the standalone kind signature:
+
+ Type -> forall j. j -> ...
+
+In step 2 (split off invisible binders), we have to decide how much remaining
+invisible binders of the standalone kind signature to split off:
+
+ forall k1 k2. (k1, k2) -> Type
+ ^^^^^^^^^^^^^
+ split off or not?
+
+This decision is made in 'split_invis':
+
+* If a user-written result kind signature is not provided, as in F,
+ then split off all invisible binders. This is why we need special treatment
+ for AnyKind.
+* If a user-written result kind signature is provided, as in G,
+ then do as checkExpectedKind does and split off (n_sig - n_res) binders.
+ That is, split off such an amount of binders that the remainder of the
+ standalone kind signature and the user-written result kind signature have the
+ same amount of invisible quantifiers.
+
+For F, split_invis splits away all invisible binders, and we have 2:
+
+ forall k1 k2. (k1, k2) -> Type
+ ^^^^^^^^^^^^^
+ split away both binders
+
+The resulting arity of F is 3+2=5. (length vis_tcbs = 3,
+ length invis_tcbs = 2,
+ length tcbs = 5)
+
+For G, split_invis decides to split off 1 invisible binder, so that we have the
+same amount of invisible quantifiers left:
+
+ res_ki = forall r2. (r1, r2) -> Type
+ kisig = forall k1 k2. (k1, k2) -> Type
+ ^^^
+ split off this one.
+
+The resulting arity of G is 3+1=4. (length vis_tcbs = 3,
+ length invis_tcbs = 1,
+ length tcbs = 4)
+
+-}
+
+{- Note [discardResult in kcCheckDeclHeader_sig]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use 'unifyKind' to check inline kind annotations in declaration headers
+against the signature.
+
+ type T :: [i] -> Maybe j -> Type
+ data T (a :: [k1]) (b :: Maybe k2) :: Type where ...
+
+Here, we will unify:
+
+ [k1] ~ [i]
+ Maybe k2 ~ Maybe j
+ Type ~ Type
+
+The end result is that we fill in unification variables k1, k2:
+
+ k1 := i
+ k2 := j
+
+We also validate that the user isn't confused:
+
+ type T :: Type -> Type
+ data T (a :: Bool) = ...
+
+This will report that (Type ~ Bool) failed to unify.
+
+Now, consider the following example:
+
+ type family Id a where Id x = x
+ type T :: Bool -> Type
+ type T (a :: Id Bool) = ...
+
+We will unify (Bool ~ Id Bool), and this will produce a non-reflexive coercion.
+However, we are free to discard it, as the kind of 'T' is determined by the
+signature, not by the inline kind annotation:
+
+ we have T :: Bool -> Type
+ rather than T :: Id Bool -> Type
+
+This (Id Bool) will not show up anywhere after we're done validating it, so we
+have no use for the produced coercion.
+-}
{- Note [No polymorphic recursion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1956,11 +2399,11 @@ be a tough nut.
Previously, we laboriously (with help from the renamer)
tried to give T the polymoprhic kind
T :: forall ka -> ka -> kappa -> Type
-where kappa is a unification variable, even in the getInitialKinds
-phase (which is what kcLHsQTyVars_NonCusk is all about). But
+where kappa is a unification variable, even in the inferInitialKinds
+phase (which is what kcInferDeclHeader is all about). But
that is dangerously fragile (see the ticket).
-Solution: make kcLHsQTyVars_NonCusk give T a straightforward
+Solution: make kcInferDeclHeader give T a straightforward
monomorphic kind, with no quantification whatsoever. That's why
we use mkAnonTyConBinder for all arguments when figuring out
tc_binders.
@@ -1970,7 +2413,7 @@ But notice that (#16322 comment:3)
* The algorithm successfully kind-checks this declaration:
data T2 ka (a::ka) = MkT2 (T2 Type a)
- Starting with (getInitialKinds)
+ Starting with (inferInitialKinds)
T2 :: (kappa1 :: kappa2 :: *) -> (kappa3 :: kappa4 :: *) -> *
we get
kappa4 := kappa1 -- from the (a:ka) kind signature
@@ -2037,7 +2480,7 @@ Then `a` first appears /after/ `f`, so the kind of `T2` should be:
T2 :: forall f a. f a -> Type
-In order to make this distinction, we need to know (in kcLHsQTyVars) which
+In order to make this distinction, we need to know (in kcCheckDeclHeader) which
type variables have been bound by the parent class (if there is one). With
the class-bound variables in hand, we can ensure that we always quantify
these first.
@@ -2218,7 +2661,6 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind)
tcHsQTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec
-
--------------------------------------
-- Binding type/class variables in the
-- kind-checking and typechecking phases
@@ -2238,7 +2680,7 @@ bindTyClTyVars tycon_name thing_inside
; tcExtendNameTyVarEnv scoped_prs $
thing_inside binders res_kind }
--- getInitialKind has made a suitably-shaped kind for the type or class
+-- inferInitialKind has made a suitably-shaped kind for the type or class
-- Look it up in the local environment. This is used only for tycons
-- that we're currently type-checking, so we're sure to find a TcTyCon.
kcLookupTcTyCon :: Name -> TcM TcTyCon
@@ -2539,6 +2981,16 @@ checkDataKindSig data_sort kind = do
then text "Perhaps you intended to use UnliftedNewtypes"
else empty ]
+-- | Checks that the result kind of a class is exactly `Constraint`, rejecting
+-- type synonyms and type families that reduce to `Constraint`. See #16826.
+checkClassKindSig :: Kind -> TcM ()
+checkClassKindSig kind = checkTc (tcIsConstraintKind kind) err_msg
+ where
+ err_msg :: SDoc
+ err_msg =
+ text "Kind signature on a class must end with" <+> ppr constraintKind $$
+ text "unobscured by type families"
+
tcbVisibilities :: TyCon -> [Type] -> [TyConBndrVis]
-- Result is in 1-1 correpondence with orig_args
tcbVisibilities tc orig_args
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index e9d75fb17f..c047d13cc8 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -746,6 +746,7 @@ tcDataFamInstDecl mb_clsinfo
L _ [] -> Nothing
L _ preds ->
Just $ DerivInfo { di_rep_tc = rep_tc
+ , di_scoped_tvs = mkTyVarNamePairs (tyConTyVars rep_tc)
, di_clauses = preds
, di_ctxt = tcMkDataFamInstCtxt decl }
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index a0297c61f5..8a15d9cd44 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -1587,11 +1587,10 @@ quantifyTyVars dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
= return Nothing -- this can happen for a covar that's associated with
-- a coercion hole. Test case: typecheck/should_compile/T2494
- | not (isTcTyVar tkv) -- I don't think this can ever happen.
- -- Hence the assert
- = ASSERT2( False, text "quantifying over a TyVar" <+> ppr tkv)
- return (Just tkv)
-
+ | not (isTcTyVar tkv)
+ = return (Just tkv) -- For associated types in a class with a standalone
+ -- kind signature, we have the class variables in
+ -- scope, and they are TyVars not TcTyVars
| otherwise
= do { deflt_done <- defaultTyVar default_kind tkv
; case deflt_done of
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 69c909f4a1..904f80827f 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -154,13 +154,17 @@ tcTyClGroup :: TyClGroup GhcRn
-- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls
tcTyClGroup (TyClGroup { group_tyclds = tyclds
, group_roles = roles
+ , group_kisigs = kisigs
, group_instds = instds })
= do { let role_annots = mkRoleAnnotEnv roles
- -- Step 1: Typecheck the type/class declarations
+ -- Step 1: Typecheck the standalone kind signatures and type/class declarations
; traceTc "---- tcTyClGroup ---- {" empty
; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds))
- ; (tyclss, data_deriv_info) <- tcTyClDecls tyclds role_annots
+ ; (tyclss, data_deriv_info) <-
+ tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution]
+ do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs
+ ; tcTyClDecls tyclds kisig_env role_annots }
-- Step 1.5: Make sure we don't have any type synonym cycles
; traceTc "Starting synonym cycle check" (ppr tyclss)
@@ -196,16 +200,19 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
tcTyClGroup (XTyClGroup nec) = noExtCon nec
+-- Gives the kind for every TyCon that has a standalone kind signature
+type KindSigEnv = NameEnv Kind
+
tcTyClDecls
:: [LTyClDecl GhcRn]
+ -> KindSigEnv
-> RoleAnnotEnv
-> TcM ([TyCon], [DerivInfo])
-tcTyClDecls tyclds role_annots
- = tcExtendKindEnv promotion_err_env $ --- See Note [Type environment evolution]
- do { -- Step 1: kind-check this group and returns the final
+tcTyClDecls tyclds kisig_env role_annots
+ = do { -- Step 1: kind-check this group and returns the final
-- (possibly-polymorphic) kind of each TyCon and Class
-- See Note [Kind checking for type and class decls]
- tc_tycons <- kcTyClGroup tyclds
+ tc_tycons <- kcTyClGroup kisig_env tyclds
; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
-- Step 2: type-check all groups together, returning
@@ -236,7 +243,6 @@ tcTyClDecls tyclds role_annots
; return (tycons, concat data_deriv_infos)
} }
where
- promotion_err_env = mkPromotionErrorEnv tyclds
ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
, ppr (tyConBinders tc) <> comma
, ppr (tyConResKind tc)
@@ -315,7 +321,7 @@ Consider
data T (a :: *) = MkT (S a) -- Has CUSK
data S a = MkS (T Int) (S a) -- No CUSK
-Via getInitialKinds we get
+Via inferInitialKinds we get
T :: * -> *
S :: kappa -> *
@@ -352,7 +358,7 @@ General type functions can be recursive, and hence, appear in `alg_decls'.
The kind of an open type family is solely determinded by its kind signature;
hence, only kind signatures participate in the construction of the initial
-kind environment (as constructed by `getInitialKind'). In fact, we ignore
+kind environment (as constructed by `inferInitialKind'). In fact, we ignore
instances of families altogether in the following. However, we need to include
the kinds of *associated* families into the construction of the initial kind
environment. (This is handled by `allDecls').
@@ -371,7 +377,7 @@ TcTyCons are used for two distinct purposes
2. When checking a type/class declaration (in module TcTyClsDecls), we come
upon knowledge of the eventual tycon in bits and pieces.
- S1) First, we use getInitialKinds to look over the user-provided
+ S1) First, we use inferInitialKinds to look over the user-provided
kind signature of a tycon (including, for example, the number
of parameters written to the tycon) to get an initial shape of
the tycon's kind. We record that shape in a TcTyCon.
@@ -397,7 +403,7 @@ TcTyCons are used for two distinct purposes
4. tyConScopedTyVars. A challenging piece in all of this is that we
end up taking three separate passes over every declaration:
- - one in getInitialKind (this pass look only at the head, not the body)
+ - one in inferInitialKind (this pass look only at the head, not the body)
- one in kcTyClDecls (to kind-check the body)
- a final one in tcTyClDecls (to desugar)
@@ -437,7 +443,7 @@ We do the following steps:
MkB :-> DataConPE
2. kcTyCLGroup
- - Do getInitialKinds, which will signal a promotion
+ - Do inferInitialKinds, which will signal a promotion
error if B is used in any of the kinds needed to initialise
B's kind (e.g. (a :: Type)) here
@@ -481,9 +487,9 @@ to Note [Single function non-recursive binding special-case]:
Unfortunately this requires reworking a bit of the code in
'kcLTyClDecl' so I've decided to punt unless someone shouts about it.
-Note [Don't process associated types in kcLHsQTyVars]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Previously, we processed associated types in the thing_inside in kcLHsQTyVars,
+Note [Don't process associated types in getInitialKind]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Previously, we processed associated types in the thing_inside in getInitialKind,
but this was wrong -- we want to do ATs sepearately.
The consequence for not doing it this way is #15142:
@@ -496,7 +502,7 @@ kappa ~ Type, but this gets deferred because we bumped the TcLevel as we bring
unified with Type. And then, when we generalize the kind of ListToTuple (which
indeed has a CUSK, according to the rules), we skolemize the free metavariable
kappa. Note that we wouldn't skolemize kappa when generalizing the kind of ListTuple,
-because the solveEqualities in kcLHsQTyVars is at TcLevel 1 and so kappa[1]
+because the solveEqualities in kcInferDeclHeader is at TcLevel 1 and so kappa[1]
will unify with Type.
Bottom line: as associated types should have no effect on a CUSK enclosing class,
@@ -505,13 +511,13 @@ been generalized.
-}
-kcTyClGroup :: [LTyClDecl GhcRn] -> TcM [TcTyCon]
+kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM [TcTyCon]
-- Kind check this group, kind generalize, and return the resulting local env
-- This binds the TyCons and Classes of the group, but not the DataCons
-- See Note [Kind checking for type and class decls]
-- and Note [Inferring kinds for type declarations]
-kcTyClGroup decls
+kcTyClGroup kisig_env decls
= do { mod <- getModule
; traceTc "---- kcTyClGroup ---- {"
(text "module" <+> ppr mod $$ vcat (map ppr decls))
@@ -523,19 +529,26 @@ kcTyClGroup decls
-- See Note [Kind checking for type and class decls]
; cusks_enabled <- xoptM LangExt.CUSKs
- ; let (cusk_decls, no_cusk_decls)
- = partition (hsDeclHasCusk cusks_enabled . unLoc) decls
+ ; let (kindless_decls, kinded_decls) = partitionWith get_kind decls
+
+ get_kind d
+ | Just ki <- lookupNameEnv kisig_env (tcdName (unLoc d))
+ = Right (d, SAKS ki)
+
+ | cusks_enabled && hsDeclHasCusk (unLoc d)
+ = Right (d, CUSK)
- ; poly_cusk_tcs <- getInitialKinds True cusk_decls
+ | otherwise = Left d
- ; mono_tcs
- <- tcExtendKindEnvWithTyCons poly_cusk_tcs $
+ ; checked_tcs <- checkInitialKinds kinded_decls
+ ; inferred_tcs
+ <- tcExtendKindEnvWithTyCons checked_tcs $
pushTcLevelM_ $ -- We are going to kind-generalise, so
-- unification variables in here must
-- be one level in
solveEqualities $
do { -- Step 1: Bind kind variables for all decls
- mono_tcs <- getInitialKinds False no_cusk_decls
+ mono_tcs <- inferInitialKinds kindless_decls
; traceTc "kcTyClGroup: initial kinds" $
ppr_tc_kinds mono_tcs
@@ -546,7 +559,7 @@ kcTyClGroup decls
-- See Note [Type environment evolution]
; poly_kinds <- xoptM LangExt.PolyKinds
; tcExtendKindEnvWithTyCons mono_tcs $
- mapM_ kcLTyClDecl (if poly_kinds then no_cusk_decls else decls)
+ mapM_ kcLTyClDecl (if poly_kinds then kindless_decls else decls)
-- See Note [Skip decls with CUSKs in kcLTyClDecl]
; return mono_tcs }
@@ -555,9 +568,9 @@ kcTyClGroup decls
-- Finally, go through each tycon and give it its final kind,
-- with all the required, specified, and inferred variables
-- in order.
- ; poly_no_cusk_tcs <- mapAndReportM generaliseTcTyCon mono_tcs
+ ; generalized_tcs <- mapAndReportM generaliseTcTyCon inferred_tcs
- ; let poly_tcs = poly_cusk_tcs ++ poly_no_cusk_tcs
+ ; let poly_tcs = checked_tcs ++ generalized_tcs
; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs)
; return poly_tcs }
@@ -772,11 +785,11 @@ How it works
These design choices are implemented by two completely different code
paths for
- * Declarations with a complete user-specified kind signature (CUSK)
- Handed by the CUSK case of kcLHsQTyVars.
+ * Declarations with a standalone kind signature or a complete user-specified
+ kind signature (CUSK). Handled by the kcCheckDeclHeader.
- * Declarations without a CUSK are handled by kcTyClDecl; see
- Note [Inferring kinds for type declarations].
+ * Declarations without a kind signature (standalone or CUSK) are handled by
+ kcInferDeclHeader; see Note [Inferring kinds for type declarations].
Note that neither code path worries about point (4) above, as this
is nicely handled by not mangling the res_kind. (Mangling res_kinds is done
@@ -821,7 +834,7 @@ that do not have a CUSK. Consider
We do kind inference as follows:
-* Step 1: getInitialKinds, and in particular kcLHsQTyVars_NonCusk.
+* Step 1: inferInitialKinds, and in particular kcInferDeclHeader.
Make a unification variable for each of the Required and Specified
type varialbes in the header.
@@ -997,17 +1010,34 @@ mk_prom_err_env decl
-- Works for family declarations too
--------------
-getInitialKinds :: Bool -> [LTyClDecl GhcRn] -> TcM [TcTyCon]
+inferInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon]
-- Returns a TcTyCon for each TyCon bound by the decls,
-- each with its initial kind
-getInitialKinds cusk decls
- = do { traceTc "getInitialKinds {" empty
- ; tcs <- concatMapM (addLocM (getInitialKind cusk)) decls
- ; traceTc "getInitialKinds done }" empty
+inferInitialKinds decls
+ = do { traceTc "inferInitialKinds {" $ ppr (map (tcdName . unLoc) decls)
+ ; tcs <- concatMapM infer_initial_kind decls
+ ; traceTc "inferInitialKinds done }" empty
; return tcs }
+ where
+ infer_initial_kind = addLocM (getInitialKind InitialKindInfer)
+
+-- Check type/class declarations against their standalone kind signatures or
+-- CUSKs, producing a generalized TcTyCon for each.
+checkInitialKinds :: [(LTyClDecl GhcRn, SAKS_or_CUSK)] -> TcM [TcTyCon]
+checkInitialKinds decls
+ = do { traceTc "checkInitialKinds {" $ ppr (mapFst (tcdName . unLoc) decls)
+ ; tcs <- concatMapM check_initial_kind decls
+ ; traceTc "checkInitialKinds done }" empty
+ ; return tcs }
+ where
+ check_initial_kind (ldecl, msig) =
+ addLocM (getInitialKind (InitialKindCheck msig)) ldecl
+
+-- | Get the initial kind of a TyClDecl, either generalized or non-generalized,
+-- depending on the 'InitialKindStrategy'.
+getInitialKind :: InitialKindStrategy -> TyClDecl GhcRn -> TcM [TcTyCon]
-getInitialKind :: Bool -> TyClDecl GhcRn -> TcM [TcTyCon]
-- Allocate a fresh kind variable for each TyCon and Class
-- For each tycon, return a TcTyCon with kind k
-- where k is the kind of tc, derived from the LHS
@@ -1020,108 +1050,208 @@ getInitialKind :: Bool -> TyClDecl GhcRn -> TcM [TcTyCon]
-- * The kind signatures on type-variable binders
-- * The result kinds signature on a TyClDecl
--
--- No family instances are passed to getInitialKinds
-
-getInitialKind cusk
+-- No family instances are passed to checkInitialKinds/inferInitialKinds
+getInitialKind strategy
(ClassDecl { tcdLName = dL->L _ name
, tcdTyVars = ktvs
, tcdATs = ats })
- = do { tycon <- kcLHsQTyVars name ClassFlavour cusk ktvs $
- return constraintKind
- ; let parent_tv_prs = tcTyConScopedTyVars tycon
- -- See Note [Don't process associated types in kcLHsQTyVars]
- ; inner_tcs <- tcExtendNameTyVarEnv parent_tv_prs $
- getFamDeclInitialKinds cusk (Just tycon) ats
- ; return (tycon : inner_tcs) }
-
-getInitialKind cusk
+ = do { cls <- kcDeclHeader strategy name ClassFlavour ktvs $
+ return (TheKind constraintKind)
+ ; let parent_tv_prs = tcTyConScopedTyVars cls
+ -- See Note [Don't process associated types in getInitialKind]
+ ; inner_tcs <-
+ tcExtendNameTyVarEnv parent_tv_prs $
+ mapM (addLocM (getAssocFamInitialKind cls)) ats
+ ; return (cls : inner_tcs) }
+ where
+ getAssocFamInitialKind cls =
+ case strategy of
+ InitialKindInfer -> get_fam_decl_initial_kind (Just cls)
+ InitialKindCheck _ -> check_initial_kind_assoc_fam cls
+
+getInitialKind strategy
(DataDecl { tcdLName = dL->L _ name
, tcdTyVars = ktvs
, tcdDataDefn = HsDataDefn { dd_kindSig = m_sig
, dd_ND = new_or_data } })
= do { let flav = newOrDataToFlavour new_or_data
- ; tc <- kcLHsQTyVars name flav cusk ktvs $
- -- See Note [Implementation of UnliftedNewtypes]
- do { unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
- ; case m_sig of
- Just ksig -> tcLHsKindSig (DataKindCtxt name) ksig
- Nothing
- | NewType <- new_or_data
- , unlifted_newtypes -> newOpenTypeKind
- | otherwise -> pure liftedTypeKind
- }
+ ctxt = DataKindCtxt name
+ ; tc <- kcDeclHeader strategy name flav ktvs $
+ case m_sig of
+ Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig
+ Nothing -> dataDeclDefaultResultKind new_or_data
; return [tc] }
-getInitialKind cusk (FamDecl { tcdFam = decl })
- = do { tc <- getFamDeclInitialKind cusk Nothing decl
+getInitialKind InitialKindInfer (FamDecl { tcdFam = decl })
+ = do { tc <- get_fam_decl_initial_kind Nothing decl
; return [tc] }
-getInitialKind cusk (SynDecl { tcdLName = dL->L _ name
- , tcdTyVars = ktvs
- , tcdRhs = rhs })
- = do { cusks_enabled <- xoptM LangExt.CUSKs
- ; tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $
- case kind_annotation cusks_enabled rhs of
- Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig
- Nothing -> newMetaKindVar
- ; return [tycon] }
- where
- -- Keep this synchronized with 'hsDeclHasCusk'.
- kind_annotation
- :: Bool -- cusks_enabled?
- -> LHsType GhcRn -- rhs
- -> Maybe (LHsKind GhcRn)
- kind_annotation False = const Nothing
- kind_annotation True = go
- where
- go (dL->L _ ty) = case ty of
- HsParTy _ lty -> go lty
- HsKindSig _ _ k -> Just k
- _ -> Nothing
+getInitialKind (InitialKindCheck msig) (FamDecl { tcdFam =
+ FamilyDecl { fdLName = unLoc -> name
+ , fdTyVars = ktvs
+ , fdResultSig = unLoc -> resultSig
+ , fdInfo = info } } )
+ = do { let flav = getFamFlav Nothing info
+ ctxt = TyFamResKindCtxt name
+ ; tc <- kcDeclHeader (InitialKindCheck msig) name flav ktvs $
+ case famResultKindSignature resultSig of
+ Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig
+ Nothing ->
+ case msig of
+ CUSK -> return (TheKind liftedTypeKind)
+ SAKS _ -> return AnyKind
+ ; return [tc] }
+
+getInitialKind strategy
+ (SynDecl { tcdLName = dL->L _ name
+ , tcdTyVars = ktvs
+ , tcdRhs = rhs })
+ = do { let ctxt = TySynKindCtxt name
+ ; tc <- kcDeclHeader strategy name TypeSynonymFlavour ktvs $
+ case hsTyKindSig rhs of
+ Just rhs_sig -> TheKind <$> tcLHsKindSig ctxt rhs_sig
+ Nothing -> return AnyKind
+ ; return [tc] }
getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec
+getInitialKind _ (FamDecl {tcdFam = XFamilyDecl nec}) = noExtCon nec
getInitialKind _ (XTyClDecl nec) = noExtCon nec
----------------------------------
-getFamDeclInitialKinds
- :: Bool -- ^ True <=> cusk
- -> Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls
- -> [LFamilyDecl GhcRn]
- -> TcM [TcTyCon]
-getFamDeclInitialKinds cusk mb_parent_tycon decls
- = mapM (addLocM (getFamDeclInitialKind cusk mb_parent_tycon)) decls
-
-getFamDeclInitialKind
- :: Bool -- ^ True <=> cusk
- -> Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls
+get_fam_decl_initial_kind
+ :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls
-> FamilyDecl GhcRn
-> TcM TcTyCon
-getFamDeclInitialKind parent_cusk mb_parent_tycon
- decl@(FamilyDecl { fdLName = (dL->L _ name)
- , fdTyVars = ktvs
- , fdResultSig = (dL->L _ resultSig)
- , fdInfo = info })
- = do { cusks_enabled <- xoptM LangExt.CUSKs
- ; kcLHsQTyVars name flav (fam_cusk cusks_enabled) ktvs $
- case resultSig of
- KindSig _ ki -> tcLHsKindSig ctxt ki
- TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki
- _ -- open type families have * return kind by default
- | tcFlavourIsOpen flav -> return liftedTypeKind
- -- closed type families have their return kind inferred
- -- by default
- | otherwise -> newMetaKindVar
- }
+get_fam_decl_initial_kind mb_parent_tycon
+ FamilyDecl { fdLName = (dL->L _ name)
+ , fdTyVars = ktvs
+ , fdResultSig = (dL->L _ resultSig)
+ , fdInfo = info }
+ = kcDeclHeader InitialKindInfer name flav ktvs $
+ case resultSig of
+ KindSig _ ki -> TheKind <$> tcLHsKindSig ctxt ki
+ TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> TheKind <$> tcLHsKindSig ctxt ki
+ _ -- open type families have * return kind by default
+ | tcFlavourIsOpen flav -> return (TheKind liftedTypeKind)
+ -- closed type families have their return kind inferred
+ -- by default
+ | otherwise -> return AnyKind
where
- assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk
- fam_cusk cusks_enabled = famDeclHasCusk cusks_enabled assoc_with_no_cusk decl
- flav = case info of
- DataFamily -> DataFamilyFlavour mb_parent_tycon
- OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon
- ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon )
- ClosedTypeFamilyFlavour
- ctxt = TyFamResKindCtxt name
-getFamDeclInitialKind _ _ (XFamilyDecl nec) = noExtCon nec
+ flav = getFamFlav mb_parent_tycon info
+ ctxt = TyFamResKindCtxt name
+get_fam_decl_initial_kind _ (XFamilyDecl nec) = noExtCon nec
+
+-- See Note [Standalone kind signatures for associated types]
+check_initial_kind_assoc_fam
+ :: TcTyCon -- parent class
+ -> FamilyDecl GhcRn
+ -> TcM TcTyCon
+check_initial_kind_assoc_fam cls
+ FamilyDecl
+ { fdLName = unLoc -> name
+ , fdTyVars = ktvs
+ , fdResultSig = unLoc -> resultSig
+ , fdInfo = info }
+ = kcDeclHeader (InitialKindCheck CUSK) name flav ktvs $
+ case famResultKindSignature resultSig of
+ Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig
+ Nothing -> return (TheKind liftedTypeKind)
+ where
+ ctxt = TyFamResKindCtxt name
+ flav = getFamFlav (Just cls) info
+check_initial_kind_assoc_fam _ (XFamilyDecl nec) = noExtCon nec
+
+{- Note [Standalone kind signatures for associated types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+If associated types had standalone kind signatures, would they wear them
+
+---------------------------+------------------------------
+ like this? (OUT) | or like this? (IN)
+---------------------------+------------------------------
+ type T :: Type -> Type | class C a where
+ class C a where | type T :: Type -> Type
+ type T a | type T a
+
+The (IN) variant is syntactically ambiguous:
+
+ class C a where
+ type T :: a -- standalone kind signature?
+ type T :: a -- declaration header?
+
+The (OUT) variant does not suffer from this issue, but it might not be the
+direction in which we want to take Haskell: we seek to unify type families and
+functions, and, by extension, associated types with class methods. And yet we
+give class methods their signatures inside the class, not outside. Neither do
+we have the counterpart of InstanceSigs for StandaloneKindSignatures.
+
+For now, we dodge the question by using CUSKs for associated types instead of
+standalone kind signatures. This is a simple addition to the rule we used to
+have before standalone kind signatures:
+
+ old rule: associated type has a CUSK iff its parent class has a CUSK
+ new rule: associated type has a CUSK iff its parent class has a CUSK or a standalone kind signature
+
+-}
+
+-- See Note [Data declaration default result kind]
+dataDeclDefaultResultKind :: NewOrData -> TcM ContextKind
+dataDeclDefaultResultKind new_or_data = do
+ -- See Note [Implementation of UnliftedNewtypes]
+ unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes
+ return $ case new_or_data of
+ NewType | unlifted_newtypes -> OpenKind
+ _ -> TheKind liftedTypeKind
+
+{- Note [Data declaration default result kind]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+When the user has not written an inline result kind annotation on a data
+declaration, we assume it to be 'Type'. That is, the following declarations
+D1 and D2 are considered equivalent:
+
+ data D1 where ...
+ data D2 :: Type where ...
+
+The consequence of this assumption is that we reject D3 even though we
+accept D4:
+
+ data D3 where
+ MkD3 :: ... -> D3 param
+
+ data D4 :: Type -> Type where
+ MkD4 :: ... -> D4 param
+
+However, there's a twist: when -XUnliftedNewtypes are enabled, we must relax
+the assumed result kind to (TYPE r) for newtypes:
+
+ newtype D5 where
+ MkD5 :: Int# -> D5
+
+dataDeclDefaultResultKind takes care to produce the appropriate result kind.
+-}
+
+---------------------------------
+getFamFlav
+ :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls
+ -> FamilyInfo pass
+ -> TyConFlavour
+getFamFlav mb_parent_tycon info =
+ case info of
+ DataFamily -> DataFamilyFlavour mb_parent_tycon
+ OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon
+ ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) -- See Note [Closed type family mb_parent_tycon]
+ ClosedTypeFamilyFlavour
+
+{- Note [Closed type family mb_parent_tycon]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's no way to write a closed type family inside a class declaration:
+
+ class C a where
+ type family F a where -- error: parse error on input ‘where’
+
+In fact, it is not clear what the meaning of such a declaration would be.
+Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing.
+-}
------------------------------------------------------------------------
kcLTyClDecl :: LTyClDecl GhcRn -> TcM ()
@@ -1139,7 +1269,7 @@ kcTyClDecl :: TyClDecl GhcRn -> TcM ()
-- This function is used solely for its side effect on kind variables
-- NB kind signatures on the type variables and
-- result kind signature have already been dealt with
--- by getInitialKind, so we can ignore them here.
+-- by inferInitialKind, so we can ignore them here.
kcTyClDecl (DataDecl { tcdLName = (dL->L _ name)
, tcdDataDefn = defn })
@@ -1150,7 +1280,7 @@ kcTyClDecl (DataDecl { tcdLName = (dL->L _ name)
-- See Note [Implementation of UnliftedNewtypes] STEP 2
; kcConDecls new_or_data (tyConResKind tyCon) cons
}
- -- hs_tvs and dd_kindSig already dealt with in getInitialKind
+ -- hs_tvs and dd_kindSig already dealt with in inferInitialKind
-- This must be a GADT-style decl,
-- (see invariants of DataDefn declaration)
-- so (a) we don't need to bring the hs_tvs into scope, because the
@@ -1170,7 +1300,7 @@ kcTyClDecl (SynDecl { tcdLName = dL->L _ name, tcdRhs = rhs })
= bindTyClTyVars name $ \ _ res_kind ->
discardResult $ tcCheckLHsType rhs res_kind
-- NB: check against the result kind that we allocated
- -- in getInitialKinds.
+ -- in inferInitialKinds.
kcTyClDecl (ClassDecl { tcdLName = (dL->L _ name)
, tcdCtxt = ctxt, tcdSigs = sigs })
@@ -1304,7 +1434,7 @@ corner, to pass to kcConDecl c.f. #16828. Hence the splitPiTys here.
I am a bit concerned about tycons with a declaration like
data T a :: Type -> forall k. k -> Type where ...
-It does not have a CUSK, so kcLHsQTyVars_NonCusk will make a TcTyCon
+It does not have a CUSK, so kcInferDeclHeader will make a TcTyCon
with tyConResKind of Type -> forall k. k -> Type. Even that is fine:
the splitPiTys will look past the forall. But I'm bothered about
what if the type "in the corner" metions k? This is incredibly
@@ -1468,7 +1598,7 @@ Expected behavior of UnliftedNewtypes:
What follows is a high-level overview of the implementation of the
proposal.
-STEP 1: Getting the initial kind, as done by getInitialKind. We have
+STEP 1: Getting the initial kind, as done by inferInitialKind. We have
two sub-cases (assuming we have a newtype and -XUnliftedNewtypes is enabled):
* With a CUSK: no change in kind-checking; the tycon is given the kind
@@ -1489,7 +1619,7 @@ enabled (we use r0 to denote a unification variable):
newtype Foo rep = MkFoo (forall (a :: TYPE rep). a)
+ kcConDecl unifies (TYPE r0) with (TYPE rep), where (TYPE r0)
- is the kind that getInitialKind invented for (Foo rep).
+ is the kind that inferInitialKind invented for (Foo rep).
data Color = Red | Blue
type family Interpret (x :: Color) :: RuntimeRep where
@@ -1587,6 +1717,10 @@ wiredInDerivInfo tycon decl
| DataDecl { tcdDataDefn = dataDefn } <- decl
, HsDataDefn { dd_derivs = derivs } <- dataDefn
= [ DerivInfo { di_rep_tc = tycon
+ , di_scoped_tvs =
+ if isFunTyCon tycon || isPrimTyCon tycon
+ then [] -- no tyConTyVars
+ else mkTyVarNamePairs (tyConTyVars tycon)
, di_clauses = unLoc derivs
, di_ctxt = tcMkDeclCtxt decl } ]
wiredInDerivInfo _ _ = []
@@ -1645,8 +1779,7 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs
= fixM $ \ clas ->
-- We need the knot because 'clas' is passed into tcClassATs
bindTyClTyVars class_name $ \ binders res_kind ->
- do { MASSERT2( tcIsConstraintKind res_kind
- , ppr class_name $$ ppr res_kind )
+ do { checkClassKindSig res_kind
; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders)
; let tycon_name = class_name -- We use the same name
roles = roles_info tycon_name -- for TyCon and Class
@@ -1983,7 +2116,8 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
-- Process the equations, creating CoAxBranches
; let tc_fam_tc = mkTcTyCon tc_name binders res_kind
- [] False {- this doesn't matter here -}
+ noTcTyConScopedTyVars
+ False {- this doesn't matter here -}
ClosedTypeFamilyFlavour
; branches <- mapAndReportM (tcTyFamInstEqn tc_fam_tc NotAssociated) eqns
@@ -2082,7 +2216,7 @@ tcDataDefn err_ctxt
(HsDataDefn { dd_ND = new_or_data, dd_cType = cType
, dd_ctxt = ctxt
, dd_kindSig = mb_ksig -- Already in tc's kind
- -- via getInitialKinds
+ -- via inferInitialKinds
, dd_cons = cons
, dd_derivs = derivs })
= do { gadt_syntax <- dataDeclChecks tc_name new_or_data ctxt cons
@@ -2122,7 +2256,11 @@ tcDataDefn err_ctxt
stupid_theta tc_rhs
(VanillaAlgTyCon tc_rep_nm)
gadt_syntax) }
+ ; tctc <- tcLookupTcTyCon tc_name
+ -- 'tctc' is a 'TcTyCon' and has the 'tcTyConScopedTyVars' that we need
+ -- unlike the finalized 'tycon' defined above which is an 'AlgTyCon'
; let deriv_info = DerivInfo { di_rep_tc = tycon
+ , di_scoped_tvs = tcTyConScopedTyVars tctc
, di_clauses = unLoc derivs
, di_ctxt = err_ctxt }
; traceTc "tcDataDefn" (ppr tc_name $$ ppr tycon_binders $$ ppr extra_bndrs)
@@ -2299,7 +2437,7 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty
-- have checked that the number of patterns matches tyConArity
-- This code is closely related to the code
- -- in TcHsType.kcLHsQTyVars_Cusk
+ -- in TcHsType.kcCheckDeclHeader_cusk
; (imp_tvs, (exp_tvs, (lhs_ty, rhs_ty)))
<- pushTcLevelM_ $
solveEqualities $
@@ -4098,7 +4236,7 @@ badMethPred sel_id pred
noClassTyVarErr :: Class -> TyCon -> SDoc
noClassTyVarErr clas fam_tc
- = sep [ text "The associated type" <+> quotes (ppr fam_tc)
+ = sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc)))
, text "mentions none of the type or kind variables of the class" <+>
quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))]
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 7fe947678a..7fa45ae8f3 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -596,6 +596,8 @@ data UserTypeCtxt
| InfSigCtxt Name -- Inferred type for function
| ExprSigCtxt -- Expression type signature
| KindSigCtxt -- Kind signature
+ | StandaloneKindSigCtxt -- Standalone kind signature
+ Name -- Name of the type/class
| TypeAppCtxt -- Visible type application
| ConArgCtxt Name -- Data constructor argument
| TySynCtxt Name -- RHS of a type synonym decl
@@ -653,6 +655,7 @@ pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr
pprUserTypeCtxt (RuleSigCtxt n) = text "a RULE for" <+> quotes (ppr n)
pprUserTypeCtxt ExprSigCtxt = text "an expression type signature"
pprUserTypeCtxt KindSigCtxt = text "a kind signature"
+pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n)
pprUserTypeCtxt TypeAppCtxt = text "a type argument"
pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c)
pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c)
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index eaec2dbd2f..307ec6d0c5 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -232,6 +232,7 @@ wantAmbiguityCheck ctxt
GhciCtxt {} -> False
TySynCtxt {} -> False
TypeAppCtxt -> False
+ StandaloneKindSigCtxt{} -> False
_ -> True
checkUserTypeError :: Type -> TcM ()
@@ -280,6 +281,10 @@ In a few places we do not want to check a user-specified type for ambiguity
f @ty
No need to check ty for ambiguity
+* StandaloneKindSigCtxt: type T :: ksig
+ Kinds need a different ambiguity check than types, and the currently
+ implemented check is only good for types. See #14419, in particular
+ https://gitlab.haskell.org/ghc/ghc/issues/14419#note_160844
************************************************************************
* *
@@ -343,6 +348,7 @@ checkValidType ctxt ty
ExprSigCtxt -> rank1
KindSigCtxt -> rank1
+ StandaloneKindSigCtxt{} -> rank1
TypeAppCtxt | impred_flag -> ArbitraryRank
| otherwise -> tyConArgMonoType
-- Normally, ImpredicativeTypes is handled in check_arg_type,
@@ -463,6 +469,7 @@ allConstraintsAllowed (TyVarBndrKindCtxt {}) = False
allConstraintsAllowed (DataKindCtxt {}) = False
allConstraintsAllowed (TySynKindCtxt {}) = False
allConstraintsAllowed (TyFamResKindCtxt {}) = False
+allConstraintsAllowed (StandaloneKindSigCtxt {}) = False
allConstraintsAllowed _ = True
-- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the
@@ -482,6 +489,7 @@ allConstraintsAllowed _ = True
vdqAllowed :: UserTypeCtxt -> Bool
-- Currently allowed in the kinds of types...
vdqAllowed (KindSigCtxt {}) = True
+vdqAllowed (StandaloneKindSigCtxt {}) = True
vdqAllowed (TySynCtxt {}) = True
vdqAllowed (ThBrackCtxt {}) = True
vdqAllowed (GhciCtxt {}) = True
@@ -1329,6 +1337,7 @@ okIPCtxt (TySynCtxt {}) = True -- e.g. type Blah = ?x::Int
-- #11466
okIPCtxt (KindSigCtxt {}) = False
+okIPCtxt (StandaloneKindSigCtxt {}) = False
okIPCtxt (ClassSCCtxt {}) = False
okIPCtxt (InstDeclCtxt {}) = False
okIPCtxt (SpecInstCtxt {}) = False
@@ -2149,7 +2158,7 @@ checkFamPatBinders fam_tc qtvs pats rhs
-- data T = MkT (forall (a::k). blah)
-- data family D Int = MkD (forall (a::k). blah)
-- In both cases, 'k' is not bound on the LHS, but is used on the RHS
- -- We catch the former in kcLHsQTyVars, and the latter right here
+ -- We catch the former in kcDeclHeader, and the latter right here
-- See Note [Check type-family instance binders]
; check_tvs bad_rhs_tvs (text "mentioned in the RHS")
(text "bound on the LHS of")
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 19f3f0ee56..7af2bc0ad7 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -41,6 +41,7 @@ module TyCon(
mkFamilyTyCon,
mkPromotedDataCon,
mkTcTyCon,
+ noTcTyConScopedTyVars,
-- ** Predicates on TyCons
isAlgTyCon, isVanillaAlgTyCon,
@@ -477,6 +478,8 @@ isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
-- Works for IfaceTyConBinder too
isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)
+-- Build the 'tyConKind' from the binders and the result kind.
+-- Keep in sync with 'mkTyConKind' in iface/IfaceType.
mkTyConKind :: [TyConBinder] -> Kind -> Kind
mkTyConKind bndrs res_kind = foldr mk res_kind bndrs
where
@@ -1702,6 +1705,10 @@ mkTcTyCon name binders res_kind scoped_tvs poly flav
, tcTyConIsPoly = poly
, tcTyConFlavour = flav }
+-- | No scoped type variables (to be used with mkTcTyCon).
+noTcTyConScopedTyVars :: [(Name, TcTyVar)]
+noTcTyConScopedTyVars = []
+
-- | Create an unlifted primitive 'TyCon', such as @Int#@.
mkPrimTyCon :: Name -> [TyConBinder]
-> Kind -- ^ /result/ kind, never levity-polymorphic
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index d8664eba62..f8cd1da078 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -42,7 +42,8 @@ module Type (
mkSpecForAllTy, mkSpecForAllTys,
mkVisForAllTys, mkTyCoInvForAllTy,
mkInvForAllTy, mkInvForAllTys,
- splitForAllTys, splitForAllTysSameVis, splitForAllVarBndrs,
+ splitForAllTys, splitForAllTysSameVis,
+ splitForAllVarBndrs,
splitForAllTy_maybe, splitForAllTy,
splitForAllTy_ty_maybe, splitForAllTy_co_maybe,
splitPiTy_maybe, splitPiTy, splitPiTys,
diff --git a/docs/users_guide/8.10.1-notes.rst b/docs/users_guide/8.10.1-notes.rst
index e8316d7059..907f7e288b 100644
--- a/docs/users_guide/8.10.1-notes.rst
+++ b/docs/users_guide/8.10.1-notes.rst
@@ -46,6 +46,20 @@ Language
type T = Just (Nothing :: Maybe a) -- no longer accepted
type T = Just Nothing :: Maybe (Maybe a) -- still accepted
+- A new extension :extension:`StandaloneKindSignatures` allows one to explicitly
+ specify the kind of a type constructor, as proposed in `GHC proposal #54
+ <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0054-kind-signatures.rst>`__: ::
+
+ type TypeRep :: forall k. k -> Type
+ data TypeRep a where
+ TyInt :: TypeRep Int
+ TyMaybe :: TypeRep Maybe
+ TyApp :: TypeRep a -> TypeRep b -> TypeRep (a b)
+
+ Analogous to function type signatures, a :ref:`standalone kind signature
+ <standalone-kind-signatures>` enables polymorphic recursion. This feature is
+ a replacement for :extension:`CUSKs`.
+
- GHC now parses visible, dependent quantifiers (as proposed in
`GHC proposal 35
<https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0035-forall-arrow.rst>`__),
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 8ec105f3a0..de0aabbbbb 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -7856,6 +7856,42 @@ using a parameter in the kind annotation: ::
In this case the kind parameter ``k`` is actually an implicit parameter
of the type family.
+At definition site, the arity determines what inputs can be matched on: ::
+
+ data PT (a :: Type)
+
+ type family F1 :: k -> Type
+ type instance F1 = PT
+ -- OK, 'k' can be matched on.
+
+ type family F0 :: forall k. k -> Type
+ type instance F0 = PT
+ -- Error:
+ -- • Expected kind ‘forall k. k -> Type’,
+ -- but ‘PT’ has kind ‘Type -> Type’
+ -- • In the type ‘PT’
+ -- In the type instance declaration for ‘F0’
+
+Both ``F1`` and ``F0`` have kind ``forall k. k -> Type``, but their arity
+differs.
+
+At use sites, the arity determines if the definition can be used in a
+higher-rank scenario: ::
+
+ type HRK (f :: forall k. k -> Type) = (f Int, f Maybe, f True)
+
+ type H1 = HRK F0 -- OK
+ type H2 = HRK F1
+ -- Error:
+ -- • Expected kind ‘forall k. k -> Type’,
+ -- but ‘F1’ has kind ‘k0 -> Type’
+ -- • In the first argument of ‘HRK’, namely ‘F1’
+ -- In the type ‘HRK F1’
+ -- In the type declaration for ‘H2’
+
+This is a consequence of the requirement that all applications of a type family
+must be fully saturated with respect to their arity.
+
.. _type-instance-declarations:
Type instance declarations
@@ -9148,6 +9184,9 @@ Complete user-supplied kind signatures and polymorphic recursion
:since: 8.10.1
+NB! This is a legacy feature, see :extension:`StandaloneKindSignatures` for the
+modern replacement.
+
Just as in type inference, kind inference for recursive types can only
use *monomorphic* recursion. Consider this (contrived) example: ::
@@ -9261,11 +9300,164 @@ According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undeter
It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``.
The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is
-switched on by default. When :extension:`CUSKs` is switched off, there is
-currently no way to enable polymorphic recursion in types. In the future, the
-notion of a CUSK will be replaced by top-level kind signatures
-(`GHC Proposal #36 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst>`__),
-then, after a transition period, this extension will be turned off by default, and eventually removed.
+switched on by default. This extension is scheduled for deprecation to be
+replaced with :extension:`StandaloneKindSignatures`.
+
+.. index::
+ single: standalone kind signature
+
+.. _standalone-kind-signatures:
+
+Standalone kind signatures and polymorphic recursion
+----------------------------------------------------
+
+.. extension:: StandaloneKindSignatures
+ :shortdesc: Allow the use of standalone kind signatures.
+
+ :implies: :extension:`NoCUSKs`
+ :since: 8.10.1
+
+Just as in type inference, kind inference for recursive types can only
+use *monomorphic* recursion. Consider this (contrived) example: ::
+
+ data T m a = MkT (m a) (T Maybe (m a))
+ -- GHC infers kind T :: (Type -> Type) -> Type -> Type
+
+The recursive use of ``T`` forced the second argument to have kind
+``Type``. However, just as in type inference, you can achieve polymorphic
+recursion by giving a *standalone kind signature* for ``T``: ::
+
+ type T :: (k -> Type) -> k -> Type
+ data T m a = MkT (m a) (T Maybe (m a))
+
+The standalone kind signature specifies the polymorphic kind
+for ``T``, and this signature is used for all the calls to ``T``
+including the recursive ones. In particular, the recursive use of ``T``
+is at kind ``Type``.
+
+While a standalone kind signature determines the kind of a type constructor, it
+does not determine its arity. This is of particular importance for type
+families and type synonyms, as they cannot be partially applied. See
+:ref:`type-family-declarations` for more information about arity.
+
+The arity can be specified using explicit binders and inline kind annotations::
+
+ -- arity F0 = 0
+ type F0 :: forall k. k -> Type
+ type family F0 :: forall k. k -> Type
+
+ -- arity F1 = 1
+ type F1 :: forall k. k -> Type
+ type family F1 :: k -> Type
+
+ -- arity F2 = 2
+ type F2 :: forall k. k -> Type
+ type family F2 a :: Type
+
+In absence of an inline kind annotation, the inferred arity includes all
+explicitly bound parameters and all immediately following invisible
+parameters::
+
+ -- arity FD1 = 1
+ type FD1 :: forall k. k -> Type
+ type FD1
+
+ -- arity FD2 = 2
+ type FD2 :: forall k. k -> Type
+ type FD2 a
+
+Note that ``F0``, ``F1``, ``F2``, ``FD1``, and ``FD2`` all have identical
+standalone kind signatures. The arity is inferred from the type family header.
+
+Standalone kind signatures and declaration headers
+--------------------------------------------------
+
+GHC requires that in the presence of a standalone kind signature, data
+declarations must bind all their inputs. For example: ::
+
+ type Prox1 :: k -> Type
+ data Prox1 a = MkProx1
+ -- OK.
+
+ type Prox2 :: k -> Type
+ data Prox2 = MkProx2
+ -- Error:
+ -- • Expected a type, but found something with kind ‘k -> Type’
+ -- • In the data type declaration for ‘Prox2’
+
+
+GADT-style data declarations may either bind their inputs or use an inline
+signature in addition to the standalone kind signature: ::
+
+ type GProx1 :: k -> Type
+ data GProx1 a where MkGProx1 :: GProx1 a
+ -- OK.
+
+ type GProx2 :: k -> Type
+ data GProx2 where MkGProx2 :: GProx2 a
+ -- Error:
+ -- • Expected a type, but found something with kind ‘k -> Type’
+ -- • In the data type declaration for ‘GProx2’
+
+ type GProx3 :: k -> Type
+ data GProx3 :: k -> Type where MkGProx3 :: GProx3 a
+ -- OK.
+
+ type GProx4 :: k -> Type
+ data GProx4 :: w where MkGProx4 :: GProx4 a
+ -- OK, w ~ (k -> Type)
+
+Classes are subject to the same rules: ::
+
+ type C1 :: Type -> Constraint
+ class C1 a
+ -- OK.
+
+ type C2 :: Type -> Constraint
+ class C2
+ -- Error:
+ -- • Couldn't match expected kind ‘Constraint’
+ -- with actual kind ‘Type -> Constraint’
+ -- • In the class declaration for ‘C2’
+
+On the other hand, type families are exempt from this rule: ::
+
+ type F :: Type -> Type
+ type family F
+ -- OK.
+
+Data families are tricky territory. Their headers are exempt from this rule,
+but their instances are not: ::
+
+ type T :: k -> Type
+ data family T
+ -- OK.
+
+ data instance T Int = MkT1
+ -- OK.
+
+ data instance T = MkT3
+ -- Error:
+ -- • Expecting one more argument to ‘T’
+ -- Expected a type, but ‘T’ has kind ‘k0 -> Type’
+ -- • In the data instance declaration for ‘T’
+
+This also applies to GADT-style data instances: ::
+
+ data instance T (a :: Nat) where MkN4 :: T 4
+ MKN9 :: T 9
+ -- OK.
+
+ data instance T :: Symbol -> Type where MkSN :: T "Neptune"
+ MkSJ :: T "Jupiter"
+ -- OK.
+
+ data instance T where MkT4 :: T x
+ -- Error:
+ -- • Expecting one more argument to ‘T’
+ -- Expected a type, but ‘T’ has kind ‘k0 -> Type’
+ -- • In the data instance declaration for ‘T’
+
Kind inference in closed type families
--------------------------------------
diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
index ef1d5c9f9f..3f22518769 100644
--- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
+++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
@@ -142,4 +142,5 @@ data Extension
| StarIsType
| ImportQualifiedPost
| CUSKs
+ | StandaloneKindSignatures
deriving (Eq, Enum, Show, Generic, Bounded)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 86311762a3..7bb4eb50dd 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -85,7 +85,7 @@ module Language.Haskell.TH.Lib (
viaStrategy, DerivStrategy(..),
-- **** Class
classD, instanceD, instanceWithOverlapD, Overlap(..),
- sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
+ sigD, kiSigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,
-- **** Role annotations
roleAnnotD,
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 5ec59b3737..4d3887baf2 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -435,6 +435,9 @@ instanceWithOverlapD o ctxt ty decs =
sigD :: Name -> TypeQ -> DecQ
sigD fun ty = liftM (SigD fun) $ ty
+kiSigD :: Name -> KindQ -> DecQ
+kiSigD fun ki = liftM (KiSigD fun) $ ki
+
forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
forImpD cc s str n ty
= do ty' <- ty
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 792a78b606..98ddd1c2ca 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -341,6 +341,7 @@ ppr_dec _ (InstanceD o ctxt i ds) =
text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i
$$ where_clause ds
ppr_dec _ (SigD f t) = pprPrefixOcc f <+> dcolon <+> ppr t
+ppr_dec _ (KiSigD f k) = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k
ppr_dec _ (ForeignD f) = ppr f
ppr_dec _ (InfixD fx n) = pprFixity n fx
ppr_dec _ (PragmaD p) = ppr p
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 72eadbff91..59cc5dceef 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -2029,6 +2029,7 @@ data Dec
-- ^ @{ instance {\-\# OVERLAPS \#-\}
-- Show w => Show [w] where ds }@
| SigD Name Type -- ^ @{ length :: [a] -> Int }@
+ | KiSigD Name Kind -- ^ @{ type TypeRep :: k -> Type }@
| ForeignD Foreign -- ^ @{ foreign import ... }
--{ foreign export ... }@
diff --git a/testsuite/tests/backpack/should_fail/bkpfail04.stderr b/testsuite/tests/backpack/should_fail/bkpfail04.stderr
index 07159cf277..0cb8d9cfe0 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail04.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail04.stderr
@@ -8,8 +8,10 @@
bkpfail04.bkp:7:9: error:
• Type constructor ‘A’ has conflicting definitions in the module
and its hsig file
- Main module: data A = A {foo :: Int}
- Hsig file: data A = A {bar :: Bool}
+ Main module: type A :: *
+ data A = A {foo :: Int}
+ Hsig file: type A :: *
+ data A = A {bar :: Bool}
The constructors do not match:
The record label lists for ‘A’ differ
The types for ‘A’ differ
diff --git a/testsuite/tests/backpack/should_fail/bkpfail06.stderr b/testsuite/tests/backpack/should_fail/bkpfail06.stderr
index 27e0ddf006..a707bf06b6 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail06.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail06.stderr
@@ -14,7 +14,9 @@
bkpfail06.bkp:10:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
- Main module: data T = T GHC.Types.Bool
- Hsig file: data T = T GHC.Types.Int
+ Main module: type T :: *
+ data T = T GHC.Types.Bool
+ Hsig file: type T :: *
+ data T = T GHC.Types.Int
The constructors do not match: The types for ‘T’ differ
• while checking that qimpl:H implements signature H in p[H=qimpl:H]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail07.stderr b/testsuite/tests/backpack/should_fail/bkpfail07.stderr
index f8cf6b000a..05277035dd 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail07.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail07.stderr
@@ -10,7 +10,9 @@
bkpfail07.bkp:6:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
- Main module: data T = T GHC.Types.Bool
- Hsig file: data T = T GHC.Types.Int
+ Main module: type T :: *
+ data T = T GHC.Types.Bool
+ Hsig file: type T :: *
+ data T = T GHC.Types.Int
The constructors do not match: The types for ‘T’ differ
• while checking that h[A=<A>]:H implements signature H in p[H=h[A=<A>]:H]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail10.stderr b/testsuite/tests/backpack/should_fail/bkpfail10.stderr
index 70b0853dc5..78ceaffb30 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail10.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail10.stderr
@@ -12,8 +12,10 @@
bkpfail10.bkp:8:9: error:
• Type constructor ‘H’ has conflicting definitions in the module
and its hsig file
- Main module: data H a = H a
- Hsig file: data H
+ Main module: type H :: * -> *
+ data H a = H a
+ Hsig file: type H :: *
+ data H
The types have different kinds
• while checking that q:H implements signature H in p[H=q:H]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail17.stderr b/testsuite/tests/backpack/should_fail/bkpfail17.stderr
index 7bd5c5778d..81e47ec524 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail17.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail17.stderr
@@ -9,8 +9,10 @@
<no location info>: error:
• Type constructor ‘Either’ has conflicting definitions in the module
and its hsig file
- Main module: data Either a b = Left a | Right b
+ Main module: type Either :: * -> * -> *
+ data Either a b = Left a | Right b
Hsig file: type role Either representational phantom phantom
+ type Either :: * -> * -> * -> *
data Either a b c = Left a
The types have different kinds
• while checking that Prelude implements signature ShouldFail in p[ShouldFail=Prelude]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail22.stderr b/testsuite/tests/backpack/should_fail/bkpfail22.stderr
index fe066bd039..cb0a0e23fa 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail22.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail22.stderr
@@ -16,6 +16,8 @@
bkpfail22.bkp:16:9: error:
• Type constructor ‘S’ has conflicting definitions in the module
and its hsig file
- Main module: type S = ()
- Hsig file: type S = GHC.Types.Bool
+ Main module: type S :: *
+ type S = ()
+ Hsig file: type S :: *
+ type S = GHC.Types.Bool
• while checking that badimpl:H2 implements signature H2 in q[H2=badimpl:H2]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail23.stderr b/testsuite/tests/backpack/should_fail/bkpfail23.stderr
index 00a19e2001..6a2eb8ce1e 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail23.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail23.stderr
@@ -13,8 +13,10 @@
bkpfail23.bkp:14:9: error:
• Type constructor ‘F’ has conflicting definitions in the module
and its hsig file
- Main module: type F a = ()
+ Main module: type F :: * -> *
+ type F a = ()
Hsig file: type role F phantom
+ type F :: * -> *
data F a
Illegal parameterized type synonym in implementation of abstract data.
(Try eta reducing your type synonym so that it is nullary.)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail25.stderr b/testsuite/tests/backpack/should_fail/bkpfail25.stderr
index 1a9c573157..cedcd30399 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail25.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail25.stderr
@@ -18,7 +18,9 @@ bkpfail25.bkp:7:18: warning: [-Wmissing-methods (in -Wdefault)]
bkpfail25.bkp:12:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
- Main module: type T a = a
+ Main module: type T :: * -> *
+ type T a = a
Hsig file: type role T nominal
+ type T :: * -> *
data T a
• while checking that q:H implements signature H in p[H=q:H]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail26.stderr b/testsuite/tests/backpack/should_fail/bkpfail26.stderr
index 3de59a22c7..09410cedfe 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail26.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail26.stderr
@@ -13,8 +13,10 @@
bkpfail26.bkp:15:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
- Main module: type T a = [a]
+ Main module: type T :: * -> *
+ type T a = [a]
Hsig file: type role T nominal
+ type T :: * -> *
data T a
Illegal parameterized type synonym in implementation of abstract data.
(Try eta reducing your type synonym so that it is nullary.)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail27.stderr b/testsuite/tests/backpack/should_fail/bkpfail27.stderr
index dfadb40773..bc5a8c6bd5 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail27.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail27.stderr
@@ -13,7 +13,9 @@
bkpfail27.bkp:15:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
- Main module: type T = F
- Hsig file: data T
+ Main module: type T :: *
+ type T = F
+ Hsig file: type T :: *
+ data T
Illegal type family application in implementation of abstract data.
• while checking that q:H implements signature H in p[H=q:H]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.stderr b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
index 9a1b4218e0..6cd72dcad1 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail41.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
@@ -10,10 +10,12 @@
bkpfail41.bkp:10:9: error:
• Class ‘C’ has conflicting definitions in the module
and its hsig file
- Main module: class C a where
+ Main module: type C :: * -> Constraint
+ class C a where
f :: a -> a
{-# MINIMAL f #-}
- Hsig file: class C a where
+ Hsig file: type C :: * -> Constraint
+ class C a where
f :: a -> a
default f :: a -> a
The methods do not match:
diff --git a/testsuite/tests/backpack/should_fail/bkpfail42.stderr b/testsuite/tests/backpack/should_fail/bkpfail42.stderr
index 467ab717aa..5b078910f9 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail42.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail42.stderr
@@ -6,10 +6,12 @@
bkpfail42.bkp:9:9: error:
• Type constructor ‘F’ has conflicting definitions in the module
and its hsig file
- Main module: type family F a :: *
- where F a = Int
- Hsig file: type family F a :: *
- where F a = Bool
+ Main module: type F :: * -> *
+ type family F a where
+ F a = Int
+ Hsig file: type F :: * -> *
+ type family F a where
+ F a = Bool
• while merging the signatures from:
• p[A=<A>]:A
• ...and the local signature for A
diff --git a/testsuite/tests/backpack/should_fail/bkpfail45.stderr b/testsuite/tests/backpack/should_fail/bkpfail45.stderr
index 737769384d..f28f18316b 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail45.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail45.stderr
@@ -14,8 +14,10 @@ bkpfail45.bkp:13:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
Main module: type role T phantom
+ type T :: * -> *
data T a = T
Hsig file: type role T nominal
+ type T :: * -> *
data T a = T
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
diff --git a/testsuite/tests/backpack/should_fail/bkpfail46.stderr b/testsuite/tests/backpack/should_fail/bkpfail46.stderr
index 9aeaccbb7e..908866f67c 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail46.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail46.stderr
@@ -13,8 +13,10 @@
bkpfail46.bkp:15:9: error:
• Type constructor ‘K’ has conflicting definitions in the module
and its hsig file
- Main module: type K a = GHC.Classes.Eq a :: Constraint
- Hsig file: class K a
+ Main module: type K :: * -> Constraint
+ type K a = GHC.Classes.Eq a :: Constraint
+ Hsig file: type K :: * -> Constraint
+ class K a
Illegal parameterized type synonym in implementation of abstract data.
(Try eta reducing your type synonym so that it is nullary.)
• while checking that q:A implements signature A in p[A=q:A]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail47.stderr b/testsuite/tests/backpack/should_fail/bkpfail47.stderr
index b2bc08b4c2..0eb58d8ee4 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail47.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail47.stderr
@@ -9,8 +9,10 @@ bkpfail47.bkp:9:9: error:
• Type constructor ‘T’ has conflicting definitions in the module
and its hsig file
Main module: type role T representational nominal
+ type T :: * -> * -> *
data T a b = MkT
Hsig file: type role T nominal representational
+ type T :: * -> * -> *
data T a b
The roles are not compatible:
Main module: [representational, nominal]
diff --git a/testsuite/tests/dependent/should_compile/Rae31.hs b/testsuite/tests/dependent/should_compile/Rae31.hs
index 7a50b606ee..5bc41b997e 100644
--- a/testsuite/tests/dependent/should_compile/Rae31.hs
+++ b/testsuite/tests/dependent/should_compile/Rae31.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE TemplateHaskell, TypeOperators, PolyKinds, DataKinds,
- TypeFamilies #-}
+ TypeFamilies, RankNTypes #-}
module A where
diff --git a/testsuite/tests/dependent/should_compile/mkGADTVars.hs b/testsuite/tests/dependent/should_compile/mkGADTVars.hs
index 70753256d8..13ac0248bf 100644
--- a/testsuite/tests/dependent/should_compile/mkGADTVars.hs
+++ b/testsuite/tests/dependent/should_compile/mkGADTVars.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, PolyKinds #-}
+{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-}
module GADTVars where
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs
index c432e4b90e..fd70fccad3 100644
--- a/testsuite/tests/driver/T4437.hs
+++ b/testsuite/tests/driver/T4437.hs
@@ -41,6 +41,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
"AlternativeLayoutRuleTransitional",
"UnliftedNewtypes",
"CUSKs",
+ "StandaloneKindSignatures",
"ImportQualifiedPost"]
expectedCabalOnlyExtensions :: [String]
diff --git a/testsuite/tests/ghci/prog008/ghci.prog008.stdout b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
index 5601247c3c..41efe8294b 100644
--- a/testsuite/tests/ghci/prog008/ghci.prog008.stdout
+++ b/testsuite/tests/ghci/prog008/ghci.prog008.stdout
@@ -1,8 +1,10 @@
+type C :: * -> * -> Constraint
class C a b where
c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b
c3 :: a1 -> b
{-# MINIMAL c1, c2, c3 #-}
+type C :: * -> * -> Constraint
class C a b where
c1 :: Num b => a -> b
c2 :: (Num b, Show b) => a -> b
diff --git a/testsuite/tests/ghci/scripts/T10018.stdout b/testsuite/tests/ghci/scripts/T10018.stdout
index 4f7d4807b2..069ea31d19 100644
--- a/testsuite/tests/ghci/scripts/T10018.stdout
+++ b/testsuite/tests/ghci/scripts/T10018.stdout
@@ -1,2 +1,4 @@
-data Infix a b = a :@: b -- Defined at <interactive>:2:18
+type Infix :: * -> * -> *
+data Infix a b = a :@: b
+ -- Defined at <interactive>:2:18
infixl 4 :@:
diff --git a/testsuite/tests/ghci/scripts/T10059.stdout b/testsuite/tests/ghci/scripts/T10059.stdout
index 955c95a966..3832719cee 100644
--- a/testsuite/tests/ghci/scripts/T10059.stdout
+++ b/testsuite/tests/ghci/scripts/T10059.stdout
@@ -1,4 +1,7 @@
-class (a ~ b) => (~) (a :: k) (b :: k) -- Defined in ‘GHC.Types’
+type (~) :: forall k. k -> k -> Constraint
+class (a ~ b) => (~) a b
+ -- Defined in ‘GHC.Types’
(~) :: k -> k -> Constraint
-class (a GHC.Prim.~# b) => (~) (a :: k) (b :: k)
+type (~) :: forall k. k -> k -> Constraint
+class (a GHC.Prim.~# b) => (~) a b
-- Defined in ‘GHC.Types’
diff --git a/testsuite/tests/ghci/scripts/T11051a.stdout b/testsuite/tests/ghci/scripts/T11051a.stdout
index 44fb93cae5..0a380fecd5 100644
--- a/testsuite/tests/ghci/scripts/T11051a.stdout
+++ b/testsuite/tests/ghci/scripts/T11051a.stdout
@@ -1 +1,2 @@
+type Hi :: *
data Hi
diff --git a/testsuite/tests/ghci/scripts/T11051b.stdout b/testsuite/tests/ghci/scripts/T11051b.stdout
index 613bf15c3a..8eea41e3a5 100644
--- a/testsuite/tests/ghci/scripts/T11051b.stdout
+++ b/testsuite/tests/ghci/scripts/T11051b.stdout
@@ -1 +1,2 @@
+type Hello :: *
data Hello = ...
diff --git a/testsuite/tests/ghci/scripts/T12005.stdout b/testsuite/tests/ghci/scripts/T12005.stdout
index 34cde4ad97..5e4b70ca6e 100644
--- a/testsuite/tests/ghci/scripts/T12005.stdout
+++ b/testsuite/tests/ghci/scripts/T12005.stdout
@@ -1,4 +1,5 @@
-class Defer (p :: Constraint) where
+type Defer :: Constraint -> Constraint
+class Defer p where
defer :: (p => r) -> r
{-# MINIMAL defer #-}
-- Defined at <interactive>:5:1
diff --git a/testsuite/tests/ghci/scripts/T12550.stdout b/testsuite/tests/ghci/scripts/T12550.stdout
index c7173fc426..81be552e5c 100644
--- a/testsuite/tests/ghci/scripts/T12550.stdout
+++ b/testsuite/tests/ghci/scripts/T12550.stdout
@@ -11,12 +11,14 @@ f ∷ ∀ {a ∷ ★ → ★} {b}. C a ⇒ a b
f ∷ ∀ {a ∷ ★ → ★} {b}. C a ⇒ a b
f ∷ ∀ {a ∷ ★ → ★} {b}. C a ⇒ a b
fmap ∷ ∀ {f ∷ ★ → ★} {a} {b}. Functor f ⇒ (a → b) → f a → f b
-class Functor (f ∷ ★ → ★) where
+type Functor :: (★ → ★) → Constraint
+class Functor f where
fmap ∷ ∀ a b. (a → b) → f a → f b
...
-- Defined in ‘GHC.Base’
Functor ∷ (★ → ★) → Constraint
-class Functor (f ∷ ★ → ★) where
+type Functor :: (★ → ★) → Constraint
+class Functor f where
fmap ∷ ∀ a b. (a → b) → f a → f b
(<$) ∷ ∀ a b. a → f b → f a
{-# MINIMAL fmap #-}
@@ -56,7 +58,8 @@ datatypeName
∷ ∀ {d} {t ∷ ★ → (★ → ★) → ★ → ★} {f ∷ ★ → ★} {a}.
Datatype d ⇒
t d f a → [Char]
-class Datatype (d ∷ k) where
+type Datatype :: ∀ {k}. k → Constraint
+class Datatype d where
datatypeName ∷ ∀ k1 (t ∷ k → (k1 → ★) → k1 → ★) (f ∷ k1 → ★)
(a ∷ k1).
t d f a → [Char]
diff --git a/testsuite/tests/ghci/scripts/T13407.stdout b/testsuite/tests/ghci/scripts/T13407.stdout
index 083f3a8b1f..85d73d9e89 100644
--- a/testsuite/tests/ghci/scripts/T13407.stdout
+++ b/testsuite/tests/ghci/scripts/T13407.stdout
@@ -1,3 +1,4 @@
type role Foo phantom phantom
-data Foo (a :: * -> *) (b :: k)
+type Foo :: (* -> *) -> forall k. k -> *
+data Foo a b
-- Defined at <interactive>:3:1
diff --git a/testsuite/tests/ghci/scripts/T13420.stdout b/testsuite/tests/ghci/scripts/T13420.stdout
index c6dbaf2755..030b902677 100644
--- a/testsuite/tests/ghci/scripts/T13420.stdout
+++ b/testsuite/tests/ghci/scripts/T13420.stdout
@@ -1,4 +1,5 @@
-type family F a :: * where
+type F :: * -> *
+type family F a where
F [Int] = Bool
F [a] = Double
F (a b) = Char
diff --git a/testsuite/tests/ghci/scripts/T13699.stdout b/testsuite/tests/ghci/scripts/T13699.stdout
index b5950a757b..7c30448563 100644
--- a/testsuite/tests/ghci/scripts/T13699.stdout
+++ b/testsuite/tests/ghci/scripts/T13699.stdout
@@ -1,8 +1,10 @@
+type Foo :: *
data Foo
= Foo {foo1 :: Int,
foo2 :: !Int,
foo3 :: Maybe Int,
foo4 :: !(Maybe Int)}
-- Defined at T13699.hs:3:1
+type Bar :: *
data Bar = Bar Int !Int (Maybe Int) !(Maybe Int)
-- Defined at T13699.hs:10:1
diff --git a/testsuite/tests/ghci/scripts/T15341.stdout b/testsuite/tests/ghci/scripts/T15341.stdout
index e2555f9ac9..403b50456b 100644
--- a/testsuite/tests/ghci/scripts/T15341.stdout
+++ b/testsuite/tests/ghci/scripts/T15341.stdout
@@ -1,6 +1,8 @@
-type family Foo (a :: k) :: k where
+type Foo :: forall k. k -> k
+type family Foo a where
forall k (a :: k). Foo a = a
-- Defined at T15341.hs:5:1
-type family Foo @k (a :: k) :: k where
+type Foo :: forall k. k -> k
+type family Foo @k a where
forall k (a :: k). Foo @k a = a
-- Defined at T15341.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/T15546.stdout b/testsuite/tests/ghci/scripts/T15546.stdout
index 5dc8cf3679..d14b442bb8 100644
--- a/testsuite/tests/ghci/scripts/T15546.stdout
+++ b/testsuite/tests/ghci/scripts/T15546.stdout
@@ -1,8 +1,10 @@
-type family E a b :: * where
+type E :: * -> * -> *
+type family E a b where
E a a = ()
E a b = Bool
-- Defined at <interactive>:2:1
-type family E a b :: * where
+type E :: * -> * -> *
+type family E a b where
{- #0 -} E a a = ()
{- #1 -} E a b = Bool
-- incompatible with: #0
diff --git a/testsuite/tests/ghci/scripts/T15827.stdout b/testsuite/tests/ghci/scripts/T15827.stdout
index 50df504e58..8b403d4043 100644
--- a/testsuite/tests/ghci/scripts/T15827.stdout
+++ b/testsuite/tests/ghci/scripts/T15827.stdout
@@ -1,9 +1,14 @@
-type family F1 (a :: k) :: * -- Defined at T15827.hs:9:1
+type F1 :: forall k. k -> *
+type family F1 a
+ -- Defined at T15827.hs:9:1
type instance forall k (a :: k). F1 a = Proxy a
-- Defined at T15827.hs:10:34
-type family F2 (a :: k) :: * where
+type F2 :: forall k. k -> *
+type family F2 a where
forall k (a :: k). F2 a = Proxy a
-- Defined at T15827.hs:12:1
-data family D (a :: k) -- Defined at T15827.hs:15:1
+type D :: forall k. k -> *
+data family D a
+ -- Defined at T15827.hs:15:1
data instance forall k (a :: k). D a = MkD (Proxy a)
-- Defined at T15827.hs:16:34
diff --git a/testsuite/tests/ghci/scripts/T15872.stdout b/testsuite/tests/ghci/scripts/T15872.stdout
index 623631162a..e1aa200425 100644
--- a/testsuite/tests/ghci/scripts/T15872.stdout
+++ b/testsuite/tests/ghci/scripts/T15872.stdout
@@ -1,5 +1,6 @@
MkFun :: (a -> b) -> Fun a b
Fun :: (a ~ 'OP) => * -> * -> *
+type Fun :: forall (a :: WHICH). (a ~ 'OP) => * -> * -> *
data Fun b c where
MkFun :: (b -> c) -> Fun b c
-- Defined at T15872.hs:11:1
@@ -7,10 +8,10 @@ MkFun
:: (a -> b) -> Fun @'OP @{'GHC.Types.Eq# @WHICH @'OP @'OP <>} a b
Fun :: ((a :: WHICH) ~ ('OP :: WHICH)) => * -> * -> *
type role Fun nominal nominal representational representational
-data Fun @(a :: WHICH)
- @{a1 :: (a :: WHICH) ~ ('OP :: WHICH)}
- b
- c where
+type Fun :: forall (a :: WHICH).
+ ((a :: WHICH) ~ ('OP :: WHICH)) =>
+ * -> * -> *
+data Fun @a @{a1} b c where
MkFun :: (b -> c)
-> Fun @'OP @{'GHC.Types.Eq# @WHICH @'OP @'OP <>} b c
-- Defined at T15872.hs:11:1
diff --git a/testsuite/tests/ghci/scripts/T15941.stdout b/testsuite/tests/ghci/scripts/T15941.stdout
index c6f31a7334..f9e6d339f9 100644
--- a/testsuite/tests/ghci/scripts/T15941.stdout
+++ b/testsuite/tests/ghci/scripts/T15941.stdout
@@ -1,3 +1,4 @@
+type T :: * -> * -> *
type T =
(->) @{'GHC.Types.LiftedRep} @{'GHC.Types.LiftedRep} :: * -> * -> *
-- Defined at <interactive>:2:1
diff --git a/testsuite/tests/ghci/scripts/T16030.stdout b/testsuite/tests/ghci/scripts/T16030.stdout
index d1691a6758..4efa27ce70 100644
--- a/testsuite/tests/ghci/scripts/T16030.stdout
+++ b/testsuite/tests/ghci/scripts/T16030.stdout
@@ -1,20 +1,26 @@
type role Foo1 phantom
-data Foo1 (a :: k) where
+type Foo1 :: forall k. k -> *
+data Foo1 a where
MkFoo1a :: forall k (a :: k). Proxy a -> Int -> Foo1 a
MkFoo1b :: forall k (a :: k). {a :: Proxy a, b :: Int} -> Foo1 a
-- Defined at T16030.hs:8:1
-data family Foo2 (a :: k) -- Defined at T16030.hs:12:1
+type Foo2 :: forall k. k -> *
+data family Foo2 a
+ -- Defined at T16030.hs:12:1
data instance forall k (a :: k). Foo2 a where
MkFoo2a :: forall k (a :: k). Proxy a -> Int -> Foo2 a
MkFoo2b :: forall k (a :: k). {c :: Proxy a, d :: Int} -> Foo2 a
-- Defined at T16030.hs:13:15
type role Foo1 nominal phantom
-data Foo1 @k (a :: k) where
+type Foo1 :: forall k. k -> *
+data Foo1 @k a where
MkFoo1a :: forall k (a :: k). Proxy @{k} a -> Int -> Foo1 @k a
MkFoo1b :: forall k (a :: k).
{a :: Proxy @{k} a, b :: Int} -> Foo1 @k a
-- Defined at T16030.hs:8:1
-data family Foo2 @k (a :: k) -- Defined at T16030.hs:12:1
+type Foo2 :: forall k. k -> *
+data family Foo2 @k a
+ -- Defined at T16030.hs:12:1
data instance forall k (a :: k). Foo2 @k a where
MkFoo2a :: forall k (a :: k). Proxy @{k} a -> Int -> Foo2 @k a
MkFoo2b :: forall k (a :: k).
diff --git a/testsuite/tests/ghci/scripts/T16527.stdout b/testsuite/tests/ghci/scripts/T16527.stdout
index fd4e0ef735..40688b571e 100644
--- a/testsuite/tests/ghci/scripts/T16527.stdout
+++ b/testsuite/tests/ghci/scripts/T16527.stdout
@@ -1,3 +1,4 @@
+type T :: *
data T where
MkT1 :: (Int -> Int) -> T
MkT2 :: (forall a. Maybe a) -> T
diff --git a/testsuite/tests/ghci/scripts/T4015.stdout b/testsuite/tests/ghci/scripts/T4015.stdout
index 4ce312c581..cd8867212b 100644
--- a/testsuite/tests/ghci/scripts/T4015.stdout
+++ b/testsuite/tests/ghci/scripts/T4015.stdout
@@ -1,20 +1,31 @@
+type R :: *
data R
= R {x :: Char, y :: Int, z :: Float}
| S {x :: Char}
| T {y :: Int, z :: Float}
| W
+type R :: *
data R
= R {x :: Char, y :: Int, z :: Float}
| S {x :: Char}
| T {y :: Int, z :: Float}
| W
-- Defined at T4015.hs:3:1
-data R = ... | S {...} | ... -- Defined at T4015.hs:4:10
-data R = ... | T {...} | ... -- Defined at T4015.hs:5:10
-data R = ... | W -- Defined at T4015.hs:6:10
+type R :: *
+data R = ... | S {...} | ...
+ -- Defined at T4015.hs:4:10
+type R :: *
+data R = ... | T {...} | ...
+ -- Defined at T4015.hs:5:10
+type R :: *
+data R = ... | W
+ -- Defined at T4015.hs:6:10
+type R :: *
data R = R {x :: Char, ...} | S {x :: Char} | ...
-- Defined at T4015.hs:3:14
+type R :: *
data R = R {..., y :: Int, ...} | ... | T {y :: Int, ...} | ...
-- Defined at T4015.hs:3:25
+type R :: *
data R = R {..., z :: Float} | ... | T {..., z :: Float} | ...
-- Defined at T4015.hs:3:35
diff --git a/testsuite/tests/ghci/scripts/T4087.stdout b/testsuite/tests/ghci/scripts/T4087.stdout
index 3f600bd78d..8dafaa881d 100644
--- a/testsuite/tests/ghci/scripts/T4087.stdout
+++ b/testsuite/tests/ghci/scripts/T4087.stdout
@@ -1,4 +1,5 @@
type role Equal nominal nominal
+type Equal :: * -> * -> *
data Equal a b where
Equal :: Equal a a
-- Defined at T4087.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout
index 9dfcd6c0d6..52d8a688c7 100644
--- a/testsuite/tests/ghci/scripts/T4175.stdout
+++ b/testsuite/tests/ghci/scripts/T4175.stdout
@@ -1,21 +1,30 @@
-type family A a b :: * -- Defined at T4175.hs:7:1
+type A :: * -> * -> *
+type family A a b
+ -- Defined at T4175.hs:7:1
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
type instance A Int Int = () -- Defined at T4175.hs:8:15
type instance A (B a) b = () -- Defined at T4175.hs:10:15
-data family B a -- Defined at T4175.hs:12:1
+type B :: * -> *
+data family B a
+ -- Defined at T4175.hs:12:1
instance [safe] G B -- Defined at T4175.hs:34:10
type instance A (B a) b = () -- Defined at T4175.hs:10:15
data instance B () = MkB -- Defined at T4175.hs:13:15
+type C :: * -> Constraint
class C a where
- type family D a b :: *
+ type D :: * -> * -> *
+ type family D a b
-- Defined at T4175.hs:16:5
type instance D () () = Bool -- Defined at T4175.hs:22:10
type instance D Int () = String -- Defined at T4175.hs:19:10
-type family E a :: * where
+type E :: * -> *
+type family E a where
E () = Bool
E Int = String
-- Defined at T4175.hs:24:1
-data () = () -- Defined in ‘GHC.Tuple’
+type () :: *
+data () = ()
+ -- Defined in ‘GHC.Tuple’
instance [safe] C () -- Defined at T4175.hs:21:10
instance Eq () -- Defined in ‘GHC.Classes’
instance Monoid () -- Defined in ‘GHC.Base’
@@ -28,7 +37,9 @@ instance Bounded () -- Defined in ‘GHC.Enum’
type instance D () () = Bool -- Defined at T4175.hs:22:10
type instance D Int () = String -- Defined at T4175.hs:19:10
data instance B () = MkB -- Defined at T4175.hs:13:15
-data Maybe a = Nothing | Just a -- Defined in ‘GHC.Maybe’
+type Maybe :: * -> *
+data Maybe a = Nothing | Just a
+ -- Defined in ‘GHC.Maybe’
instance Applicative Maybe -- Defined in ‘GHC.Base’
instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Maybe’
instance Functor Maybe -- Defined in ‘GHC.Base’
@@ -43,7 +54,9 @@ instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Traversable Maybe -- Defined in ‘Data.Traversable’
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
-data Int = GHC.Types.I# GHC.Prim.Int# -- Defined in ‘GHC.Types’
+type Int :: *
+data Int = GHC.Types.I# GHC.Prim.Int#
+ -- Defined in ‘GHC.Types’
instance [safe] C Int -- Defined at T4175.hs:18:10
instance Eq Int -- Defined in ‘GHC.Classes’
instance Ord Int -- Defined in ‘GHC.Classes’
@@ -56,5 +69,7 @@ instance Bounded Int -- Defined in ‘GHC.Enum’
instance Integral Int -- Defined in ‘GHC.Real’
type instance D Int () = String -- Defined at T4175.hs:19:10
type instance A Int Int = () -- Defined at T4175.hs:8:15
-class Z a -- Defined at T4175.hs:28:1
+type Z :: * -> Constraint
+class Z a
+ -- Defined at T4175.hs:28:1
instance [safe] F (Z a) -- Defined at T4175.hs:31:10
diff --git a/testsuite/tests/ghci/scripts/T5417.stdout b/testsuite/tests/ghci/scripts/T5417.stdout
index ab2827730f..163a9236de 100644
--- a/testsuite/tests/ghci/scripts/T5417.stdout
+++ b/testsuite/tests/ghci/scripts/T5417.stdout
@@ -1,9 +1,15 @@
+type B1 :: * -> *
data B1 a = B1 a
data instance C.F (B1 a) = B2 a
+type D :: * -> *
data family D a
+type C.C1 :: * -> Constraint
class C.C1 a where
+ type C.F :: * -> *
data family C.F a
+type C.C1 :: * -> Constraint
class C.C1 a where
+ type C.F :: * -> *
data family C.F a
-- Defined at T5417a.hs:7:5
data instance C.F (B1 a) = B2 a -- Defined at T5417.hs:8:10
diff --git a/testsuite/tests/ghci/scripts/T5820.stdout b/testsuite/tests/ghci/scripts/T5820.stdout
index a8dddd3863..faa5f6fc76 100644
--- a/testsuite/tests/ghci/scripts/T5820.stdout
+++ b/testsuite/tests/ghci/scripts/T5820.stdout
@@ -1,4 +1,8 @@
-data Foo = Foo -- Defined at T5820.hs:2:1
+type Foo :: *
+data Foo = Foo
+ -- Defined at T5820.hs:2:1
instance [safe] Eq Foo -- Defined at T5820.hs:3:10
-data Foo = Foo -- Defined at T5820.hs:2:1
+type Foo :: *
+data Foo = Foo
+ -- Defined at T5820.hs:2:1
instance [safe] Eq Foo -- Defined at T5820.hs:3:10
diff --git a/testsuite/tests/ghci/scripts/T6027ghci.stdout b/testsuite/tests/ghci/scripts/T6027ghci.stdout
index be1034b0c7..7711a3003f 100644
--- a/testsuite/tests/ghci/scripts/T6027ghci.stdout
+++ b/testsuite/tests/ghci/scripts/T6027ghci.stdout
@@ -1 +1,3 @@
-data (?) -- Defined at <interactive>:2:1
+type (?) :: *
+data (?)
+ -- Defined at <interactive>:2:1
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index ea9aaafb80..b86ea432ff 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -1,4 +1,6 @@
-data () = () -- Defined in ‘GHC.Tuple’
+type () :: *
+data () = ()
+ -- Defined in ‘GHC.Tuple’
instance Eq () -- Defined in ‘GHC.Classes’
instance Monoid () -- Defined in ‘GHC.Base’
instance Ord () -- Defined in ‘GHC.Classes’
@@ -7,12 +9,16 @@ instance Enum () -- Defined in ‘GHC.Enum’
instance Show () -- Defined in ‘GHC.Show’
instance Read () -- Defined in ‘GHC.Read’
instance Bounded () -- Defined in ‘GHC.Enum’
-data (##) = (##) -- Defined in ‘GHC.Prim’
+type (##) :: TYPE ('GHC.Types.TupleRep '[])
+data (##) = (##)
+ -- Defined in ‘GHC.Prim’
() :: ()
(##) :: (# #)
( ) :: ()
(# #) :: (# #)
-data (,) a b = (,) a b -- Defined in ‘GHC.Tuple’
+type (,) :: * -> * -> *
+data (,) a b = (,) a b
+ -- Defined in ‘GHC.Tuple’
instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’
instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
instance Functor ((,) a) -- Defined in ‘GHC.Base’
@@ -28,7 +34,12 @@ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
instance (Bounded a, Bounded b) => Bounded (a, b)
-- Defined in ‘GHC.Enum’
-data (#,#) (a :: TYPE k0) (b :: TYPE k1) = (#,#) a b
+type (#,#) :: *
+ -> *
+ -> TYPE
+ ('GHC.Types.TupleRep
+ '[ 'GHC.Types.LiftedRep, 'GHC.Types.LiftedRep])
+data (#,#) a b = (#,#) a b
-- Defined in ‘GHC.Prim’
(,) :: a -> b -> (a, b)
(#,#) :: a -> b -> (# a, b #)
diff --git a/testsuite/tests/ghci/scripts/T7730.stdout b/testsuite/tests/ghci/scripts/T7730.stdout
index bf9c1d025b..9c3e385c71 100644
--- a/testsuite/tests/ghci/scripts/T7730.stdout
+++ b/testsuite/tests/ghci/scripts/T7730.stdout
@@ -1,7 +1,9 @@
type role A phantom phantom
-data A (x :: k) (y :: k1)
+type A :: forall k k1. k -> k1 -> *
+data A x y
-- Defined at <interactive>:2:1
A :: k1 -> k2 -> *
type role T phantom
-data T (a :: k) = forall a1. MkT a1
+type T :: forall k. k -> *
+data T a = forall a1. MkT a1
-- Defined at <interactive>:6:1
diff --git a/testsuite/tests/ghci/scripts/T7872.stdout b/testsuite/tests/ghci/scripts/T7872.stdout
index 4c577ce1cd..4c8c1dd772 100644
--- a/testsuite/tests/ghci/scripts/T7872.stdout
+++ b/testsuite/tests/ghci/scripts/T7872.stdout
@@ -1,2 +1,6 @@
-type T = forall a. a -> a -- Defined at <interactive>:2:1
-data D = MkT (forall b. b -> b) -- Defined at <interactive>:3:1
+type T :: *
+type T = forall a. a -> a
+ -- Defined at <interactive>:2:1
+type D :: *
+data D = MkT (forall b. b -> b)
+ -- Defined at <interactive>:3:1
diff --git a/testsuite/tests/ghci/scripts/T7873.stdout b/testsuite/tests/ghci/scripts/T7873.stdout
index bcdebe71e1..4abcab8c18 100644
--- a/testsuite/tests/ghci/scripts/T7873.stdout
+++ b/testsuite/tests/ghci/scripts/T7873.stdout
@@ -1,5 +1,7 @@
+type D2 :: *
data D2
= forall k. MkD2 (forall (p :: k -> *) (a :: k). p a -> Int)
-- Defined at <interactive>:3:1
+type D3 :: *
data D3 = MkD3 (forall k (p :: k -> *) (a :: k). p a -> Int)
-- Defined at <interactive>:4:1
diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout
index 4c2a602f4f..1b6b04e3f9 100644
--- a/testsuite/tests/ghci/scripts/T7939.stdout
+++ b/testsuite/tests/ghci/scripts/T7939.stdout
@@ -1,24 +1,32 @@
-class Foo (a :: k) where
- type family Bar (a :: k) b :: *
+type Foo :: forall k. k -> Constraint
+class Foo a where
+ type Bar :: forall k. k -> * -> *
+ type family Bar a b
-- Defined at T7939.hs:6:4
Bar :: k -> * -> *
-type family F a :: * -- Defined at T7939.hs:8:1
+type F :: * -> *
+type family F a
+ -- Defined at T7939.hs:8:1
type instance F Int = Bool -- Defined at T7939.hs:9:15
F :: * -> *
-type family G a :: * where
+type G :: * -> *
+type family G a where
G Int = Bool
-- Defined at T7939.hs:11:1
G :: * -> *
-type family H (a :: Bool) :: Bool where
+type H :: Bool -> Bool
+type family H a where
H 'False = 'True
-- Defined at T7939.hs:14:1
H :: Bool -> Bool
-type family J (a :: [k]) :: Bool where
+type J :: forall k. [k] -> Bool
+type family J a where
J '[] = 'False
forall k (h :: k) (t :: [k]). J (h : t) = 'True
-- Defined at T7939.hs:17:1
J :: [k] -> Bool
-type family K (a1 :: [a]) :: Maybe a where
+type K :: forall a. [a] -> Maybe a
+type family K a1 where
K '[] = 'Nothing
forall a (h :: a) (t :: [a]). K (h : t) = 'Just h
-- Defined at T7939.hs:21:1
diff --git a/testsuite/tests/ghci/scripts/T8469.stdout b/testsuite/tests/ghci/scripts/T8469.stdout
index 1a511e6b55..7cad316fee 100644
--- a/testsuite/tests/ghci/scripts/T8469.stdout
+++ b/testsuite/tests/ghci/scripts/T8469.stdout
@@ -1,4 +1,6 @@
-data Int = GHC.Types.I# GHC.Prim.Int# -- Defined in ‘GHC.Types’
+type Int :: *
+data Int = GHC.Types.I# GHC.Prim.Int#
+ -- Defined in ‘GHC.Types’
instance Eq Int -- Defined in ‘GHC.Classes’
instance Ord Int -- Defined in ‘GHC.Classes’
instance Enum Int -- Defined in ‘GHC.Enum’
diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout
index 4effb90a52..7a949cd465 100644
--- a/testsuite/tests/ghci/scripts/T8535.stdout
+++ b/testsuite/tests/ghci/scripts/T8535.stdout
@@ -1,4 +1,6 @@
-data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
+type (->) :: * -> * -> *
+data (->) a b
+ -- Defined in ‘GHC.Prim’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/T8579.stdout b/testsuite/tests/ghci/scripts/T8579.stdout
index 2db09d7fd4..b9f7c748f4 100644
--- a/testsuite/tests/ghci/scripts/T8579.stdout
+++ b/testsuite/tests/ghci/scripts/T8579.stdout
@@ -1,2 +1,6 @@
-data A = Y -- Defined at <interactive>:2:1
-data A = Y -- Defined at <interactive>:2:1
+type A :: *
+data A = Y
+ -- Defined at <interactive>:2:1
+type A :: *
+data A = Y
+ -- Defined at <interactive>:2:1
diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout
index d938f95692..7d7beeb1cd 100644
--- a/testsuite/tests/ghci/scripts/T8674.stdout
+++ b/testsuite/tests/ghci/scripts/T8674.stdout
@@ -1,4 +1,6 @@
-data family Sing (a :: k) -- Defined at T8674.hs:4:1
+type Sing :: forall k. k -> *
+data family Sing a
+ -- Defined at T8674.hs:4:1
data instance Sing Bool = SBool -- Defined at T8674.hs:6:15
data instance forall k (a :: [k]). Sing a = SNil
-- Defined at T8674.hs:5:15
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
index a30879c316..388681ed63 100644
--- a/testsuite/tests/ghci/scripts/T9181.stdout
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -1,9 +1,10 @@
-type family GHC.TypeLits.AppendSymbol (a :: GHC.Types.Symbol)
- (b :: GHC.Types.Symbol)
- :: GHC.Types.Symbol
-type family GHC.TypeLits.CmpSymbol (a :: GHC.Types.Symbol)
- (b :: GHC.Types.Symbol)
- :: Ordering
+type GHC.TypeLits.AppendSymbol :: GHC.Types.Symbol
+ -> GHC.Types.Symbol -> GHC.Types.Symbol
+type family GHC.TypeLits.AppendSymbol a b
+type GHC.TypeLits.CmpSymbol :: GHC.Types.Symbol
+ -> GHC.Types.Symbol -> Ordering
+type family GHC.TypeLits.CmpSymbol a b
+type GHC.TypeLits.ErrorMessage :: *
data GHC.TypeLits.ErrorMessage
= GHC.TypeLits.Text GHC.Types.Symbol
| forall t. GHC.TypeLits.ShowType t
@@ -13,15 +14,18 @@ data GHC.TypeLits.ErrorMessage
| GHC.TypeLits.ErrorMessage
GHC.TypeLits.:$$:
GHC.TypeLits.ErrorMessage
-class GHC.TypeLits.KnownSymbol (n :: GHC.Types.Symbol) where
+type GHC.TypeLits.KnownSymbol :: GHC.Types.Symbol -> Constraint
+class GHC.TypeLits.KnownSymbol n where
GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n
{-# MINIMAL symbolSing #-}
+type GHC.TypeLits.SomeSymbol :: *
data GHC.TypeLits.SomeSymbol
= forall (n :: GHC.Types.Symbol).
GHC.TypeLits.KnownSymbol n =>
GHC.TypeLits.SomeSymbol (Data.Proxy.Proxy n)
-type family GHC.TypeLits.TypeError (a :: GHC.TypeLits.ErrorMessage)
- :: b where
+type GHC.TypeLits.TypeError :: forall b.
+ GHC.TypeLits.ErrorMessage -> b
+type family GHC.TypeLits.TypeError a where
GHC.TypeLits.natVal ::
GHC.TypeNats.KnownNat n => proxy n -> Integer
GHC.TypeLits.natVal' ::
@@ -36,42 +40,48 @@ GHC.TypeLits.symbolVal ::
GHC.TypeLits.KnownSymbol n => proxy n -> String
GHC.TypeLits.symbolVal' ::
GHC.TypeLits.KnownSymbol n => GHC.Prim.Proxy# n -> String
-type family (GHC.TypeNats.*) (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
-type family (GHC.TypeNats.+) (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
-type family (GHC.TypeNats.-) (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
-type (GHC.TypeNats.<=) (x :: GHC.Types.Nat) (y :: GHC.Types.Nat) =
+type (GHC.TypeNats.*) :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family (GHC.TypeNats.*) a b
+type (GHC.TypeNats.+) :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family (GHC.TypeNats.+) a b
+type (GHC.TypeNats.-) :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family (GHC.TypeNats.-) a b
+type (GHC.TypeNats.<=) :: GHC.Types.Nat
+ -> GHC.Types.Nat -> Constraint
+type (GHC.TypeNats.<=) x y =
(x GHC.TypeNats.<=? y) ~ 'True :: Constraint
-type family (GHC.TypeNats.<=?) (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: Bool
-type family GHC.TypeNats.CmpNat (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: Ordering
-type family GHC.TypeNats.Div (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
-class GHC.TypeNats.KnownNat (n :: GHC.Types.Nat) where
+type (GHC.TypeNats.<=?) :: GHC.Types.Nat -> GHC.Types.Nat -> Bool
+type family (GHC.TypeNats.<=?) a b
+type GHC.TypeNats.CmpNat :: GHC.Types.Nat
+ -> GHC.Types.Nat -> Ordering
+type family GHC.TypeNats.CmpNat a b
+type GHC.TypeNats.Div :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family GHC.TypeNats.Div a b
+type GHC.TypeNats.KnownNat :: GHC.Types.Nat -> Constraint
+class GHC.TypeNats.KnownNat n where
GHC.TypeNats.natSing :: GHC.TypeNats.SNat n
{-# MINIMAL natSing #-}
-type family GHC.TypeNats.Log2 (a :: GHC.Types.Nat) :: GHC.Types.Nat
-type family GHC.TypeNats.Mod (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
+type GHC.TypeNats.Log2 :: GHC.Types.Nat -> GHC.Types.Nat
+type family GHC.TypeNats.Log2 a
+type GHC.TypeNats.Mod :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family GHC.TypeNats.Mod a b
+type GHC.Types.Nat :: *
data GHC.Types.Nat
+type GHC.TypeNats.SomeNat :: *
data GHC.TypeNats.SomeNat
= forall (n :: GHC.Types.Nat).
GHC.TypeNats.KnownNat n =>
GHC.TypeNats.SomeNat (Data.Proxy.Proxy n)
+type GHC.Types.Symbol :: *
data GHC.Types.Symbol
-type family (GHC.TypeNats.^) (a :: GHC.Types.Nat)
- (b :: GHC.Types.Nat)
- :: GHC.Types.Nat
+type (GHC.TypeNats.^) :: GHC.Types.Nat
+ -> GHC.Types.Nat -> GHC.Types.Nat
+type family (GHC.TypeNats.^) a b
GHC.TypeNats.sameNat ::
(GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) =>
Data.Proxy.Proxy a
diff --git a/testsuite/tests/ghci/scripts/T9881.stdout b/testsuite/tests/ghci/scripts/T9881.stdout
index 68acea7c61..57bc6256d3 100644
--- a/testsuite/tests/ghci/scripts/T9881.stdout
+++ b/testsuite/tests/ghci/scripts/T9881.stdout
@@ -1,3 +1,4 @@
+type Data.ByteString.Lazy.ByteString :: *
data Data.ByteString.Lazy.ByteString
= Data.ByteString.Lazy.Internal.Empty
| Data.ByteString.Lazy.Internal.Chunk {-# UNPACK #-}Data.ByteString.ByteString
@@ -16,6 +17,7 @@ instance Show Data.ByteString.Lazy.ByteString
instance Read Data.ByteString.Lazy.ByteString
-- Defined in ‘Data.ByteString.Lazy.Internal’
+type Data.ByteString.ByteString :: *
data Data.ByteString.ByteString
= Data.ByteString.Internal.PS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr
GHC.Word.Word8)
diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout
index abed6d21f3..3f62f3f7f2 100644
--- a/testsuite/tests/ghci/scripts/ghci008.stdout
+++ b/testsuite/tests/ghci/scripts/ghci008.stdout
@@ -1,19 +1,24 @@
+type Num :: * -> Constraint
class Num a where
(+) :: a -> a -> a
...
-- Defined in ‘GHC.Num’
infixl 6 +
+type Num :: * -> Constraint
class Num a where
(+) :: a -> a -> a
...
-- Defined in ‘GHC.Num’
infixl 6 +
+type Data.Complex.Complex :: * -> *
data Data.Complex.Complex a = !a Data.Complex.:+ !a
-- Defined in ‘Data.Complex’
infix 6 Data.Complex.:+
+type Data.Complex.Complex :: * -> *
data Data.Complex.Complex a = !a Data.Complex.:+ !a
-- Defined in ‘Data.Complex’
infix 6 Data.Complex.:+
+type RealFloat :: * -> Constraint
class (RealFrac a, Floating a) => RealFloat a where
floatRadix :: a -> Integer
floatDigits :: a -> Int
diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout
index 6dd5782d6c..35f4b9fda2 100644
--- a/testsuite/tests/ghci/scripts/ghci011.stdout
+++ b/testsuite/tests/ghci/scripts/ghci011.stdout
@@ -1,4 +1,6 @@
-data [] a = [] | a : [a] -- Defined in ‘GHC.Types’
+type [] :: * -> *
+data [] a = [] | a : [a]
+ -- Defined in ‘GHC.Types’
instance Applicative [] -- Defined in ‘GHC.Base’
instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’
instance Functor [] -- Defined in ‘GHC.Base’
@@ -11,7 +13,9 @@ instance MonadFail [] -- Defined in ‘Control.Monad.Fail’
instance Read a => Read [a] -- Defined in ‘GHC.Read’
instance Foldable [] -- Defined in ‘Data.Foldable’
instance Traversable [] -- Defined in ‘Data.Traversable’
-data () = () -- Defined in ‘GHC.Tuple’
+type () :: *
+data () = ()
+ -- Defined in ‘GHC.Tuple’
instance Eq () -- Defined in ‘GHC.Classes’
instance Monoid () -- Defined in ‘GHC.Base’
instance Ord () -- Defined in ‘GHC.Classes’
@@ -20,7 +24,9 @@ instance Enum () -- Defined in ‘GHC.Enum’
instance Show () -- Defined in ‘GHC.Show’
instance Read () -- Defined in ‘GHC.Read’
instance Bounded () -- Defined in ‘GHC.Enum’
-data (,) a b = (,) a b -- Defined in ‘GHC.Tuple’
+type (,) :: * -> * -> *
+data (,) a b = (,) a b
+ -- Defined in ‘GHC.Tuple’
instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’
instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
instance Functor ((,) a) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci019.stdout b/testsuite/tests/ghci/scripts/ghci019.stdout
index d03720d2b5..0a9fefb77b 100644
--- a/testsuite/tests/ghci/scripts/ghci019.stdout
+++ b/testsuite/tests/ghci/scripts/ghci019.stdout
@@ -1,2 +1,4 @@
-data Foo = Foo -- Defined at ghci019.hs:8:1
+type Foo :: *
+data Foo = Foo
+ -- Defined at ghci019.hs:8:1
instance [safe] Prelude.Eq Foo -- Defined at ghci019.hs:9:10
diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout
index 4effb90a52..7a949cd465 100644
--- a/testsuite/tests/ghci/scripts/ghci020.stdout
+++ b/testsuite/tests/ghci/scripts/ghci020.stdout
@@ -1,4 +1,6 @@
-data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
+type (->) :: * -> * -> *
+data (->) a b
+ -- Defined in ‘GHC.Prim’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci023.stdout b/testsuite/tests/ghci/scripts/ghci023.stdout
index 9403102dd9..70c64c4293 100644
--- a/testsuite/tests/ghci/scripts/ghci023.stdout
+++ b/testsuite/tests/ghci/scripts/ghci023.stdout
@@ -12,6 +12,7 @@ Data.Maybe.listToMaybe :: [a] -> Maybe a
Data.Maybe.mapMaybe :: (a -> Maybe b) -> [a] -> [b]
maybe :: b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybeToList :: Maybe a -> [a]
+type Maybe :: * -> *
data Maybe a = Nothing | Just a
-- via readFile
(True,False)
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index 9c862d340c..3531825a97 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -2,8 +2,11 @@
:browse! *T
-- defined locally
T.length :: T.Integer
+type N :: * -> Constraint
class N a
+type S :: * -> Constraint
class S a
+type C :: * -> * -> Constraint
class C a b
...
c1 :: (C a b, N b) => a -> b
@@ -11,7 +14,8 @@ c2 :: (C a b, N b, S b) => a -> b
c3 :: C a b => a -> b
c4 :: C a b => a1 -> b
-- imported via Control.Monad
-class (GHC.Base.Alternative m, Monad m) => MonadPlus (m :: * -> *)
+type MonadPlus :: (* -> *) -> Constraint
+class (GHC.Base.Alternative m, Monad m) => MonadPlus m
...
mplus :: MonadPlus m => m a -> m a -> m a
mzero :: MonadPlus m => m a
@@ -20,7 +24,8 @@ mzero :: MonadPlus m => m a
(>>=) :: Monad m => m a -> (a -> m b) -> m b
return :: Monad m => a -> m a
-- imported via Control.Monad, Prelude, T
-class GHC.Base.Applicative m => Monad (m :: * -> *)
+type Monad :: (* -> *) -> Constraint
+class GHC.Base.Applicative m => Monad m
...
-- imported via Data.Maybe
catMaybes :: [Maybe a] -> [a]
@@ -34,23 +39,29 @@ maybe :: b -> (a -> b) -> Maybe a -> b
maybeToList :: Maybe a -> [a]
-- imported via Data.Maybe, Prelude
Just :: a -> Maybe a
+type Maybe :: * -> *
data Maybe a = ...
Nothing :: Maybe a
-- imported via Prelude
(+) :: GHC.Num.Num a => a -> a -> a
(=<<) :: Monad m => (a -> m b) -> m a -> m b
+type Eq :: * -> Constraint
class Eq a
...
-- imported via Prelude, T
Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int
-- imported via T
+type T.Integer :: *
data T.Integer = ...
T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int
:browse! T
-- defined locally
T.length :: T.Integer
+type N :: * -> Constraint
class N a
+type S :: * -> Constraint
class S a
+type C :: * -> * -> Constraint
class C a b
...
c1 :: (C a b, N b) => a -> b
@@ -60,8 +71,11 @@ c4 :: C a b => a1 -> b
:browse! T -- with -fprint-explicit-foralls
-- defined locally
T.length :: T.Integer
+type N :: * -> Constraint
class N a
+type S :: * -> Constraint
class S a
+type C :: * -> * -> Constraint
class C a b
...
c1 :: forall a b. (C a b, N b) => a -> b
diff --git a/testsuite/tests/ghci/scripts/ghci026.stdout b/testsuite/tests/ghci/scripts/ghci026.stdout
index 24049ee655..d8e282a3b2 100644
--- a/testsuite/tests/ghci/scripts/ghci026.stdout
+++ b/testsuite/tests/ghci/scripts/ghci026.stdout
@@ -7,7 +7,9 @@ listToMaybe :: [a] -> Maybe a
mapMaybe :: (a -> Maybe b) -> [a] -> [b]
maybe :: b -> (a -> b) -> Maybe a -> b
maybeToList :: Maybe a -> [a]
+type Maybe :: * -> *
data Maybe a = Nothing | Just a
+type T :: *
data T = A Int | B Float
f :: Double -> Double
g :: Double -> Double
diff --git a/testsuite/tests/ghci/scripts/ghci027.stdout b/testsuite/tests/ghci/scripts/ghci027.stdout
index bbe355c17a..e152e7419a 100644
--- a/testsuite/tests/ghci/scripts/ghci027.stdout
+++ b/testsuite/tests/ghci/scripts/ghci027.stdout
@@ -1,8 +1,10 @@
+type GHC.Base.MonadPlus :: (* -> *) -> Constraint
class (GHC.Base.Alternative m, GHC.Base.Monad m) =>
- GHC.Base.MonadPlus (m :: * -> *) where
+ GHC.Base.MonadPlus m where
...
mplus :: m a -> m a -> m a
+type GHC.Base.MonadPlus :: (* -> *) -> Constraint
class (GHC.Base.Alternative m, GHC.Base.Monad m) =>
- GHC.Base.MonadPlus (m :: * -> *) where
+ GHC.Base.MonadPlus m where
...
Control.Monad.mplus :: m a -> m a -> m a
diff --git a/testsuite/tests/ghci/scripts/ghci030.stdout b/testsuite/tests/ghci/scripts/ghci030.stdout
index 49ce606456..1195afc37d 100644
--- a/testsuite/tests/ghci/scripts/ghci030.stdout
+++ b/testsuite/tests/ghci/scripts/ghci030.stdout
@@ -1,2 +1,6 @@
-data D = forall a. C (Int -> a) Char -- Defined at ghci030.hs:8:1
-data D = forall a. C (Int -> a) Char -- Defined at ghci030.hs:8:10
+type D :: *
+data D = forall a. C (Int -> a) Char
+ -- Defined at ghci030.hs:8:1
+type D :: *
+data D = forall a. C (Int -> a) Char
+ -- Defined at ghci030.hs:8:10
diff --git a/testsuite/tests/ghci/scripts/ghci031.stdout b/testsuite/tests/ghci/scripts/ghci031.stdout
index 796433e1b7..6ed977034c 100644
--- a/testsuite/tests/ghci/scripts/ghci031.stdout
+++ b/testsuite/tests/ghci/scripts/ghci031.stdout
@@ -1,3 +1,4 @@
type role D nominal
+type D :: * -> *
data Eq a => D a = C a
-- Defined at ghci031.hs:7:1
diff --git a/testsuite/tests/ghci/scripts/ghci033.stdout b/testsuite/tests/ghci/scripts/ghci033.stdout
index e4bfebeb39..4deea62397 100644
--- a/testsuite/tests/ghci/scripts/ghci033.stdout
+++ b/testsuite/tests/ghci/scripts/ghci033.stdout
@@ -1,2 +1,3 @@
+type Foo :: *
data Foo = Foo1 Int | Int `InfixCon` Bool
-- Defined at ghci033.hs:4:1
diff --git a/testsuite/tests/ghci/scripts/ghci040.stdout b/testsuite/tests/ghci/scripts/ghci040.stdout
index d9ebd9c59e..bfd78971a7 100644
--- a/testsuite/tests/ghci/scripts/ghci040.stdout
+++ b/testsuite/tests/ghci/scripts/ghci040.stdout
@@ -1 +1,3 @@
-data Ghci1.T = A | ... -- Defined at <interactive>:2:10
+type Ghci1.T :: *
+data Ghci1.T = A | ...
+ -- Defined at <interactive>:2:10
diff --git a/testsuite/tests/ghci/scripts/ghci041.stdout b/testsuite/tests/ghci/scripts/ghci041.stdout
index 14b8726c76..67a68f00be 100644
--- a/testsuite/tests/ghci/scripts/ghci041.stdout
+++ b/testsuite/tests/ghci/scripts/ghci041.stdout
@@ -1 +1,3 @@
-data R = A | ... -- Defined at <interactive>:3:10
+type R :: *
+data R = A | ...
+ -- Defined at <interactive>:3:10
diff --git a/testsuite/tests/ghci/scripts/ghci042.stdout b/testsuite/tests/ghci/scripts/ghci042.stdout
index 5cb84f632f..d68caeb6b4 100644
--- a/testsuite/tests/ghci/scripts/ghci042.stdout
+++ b/testsuite/tests/ghci/scripts/ghci042.stdout
@@ -1,6 +1,14 @@
-data T = A {...} -- Defined at <interactive>:2:10
-data T = A {a :: Int} -- Defined at <interactive>:2:13
+type T :: *
+data T = A {...}
+ -- Defined at <interactive>:2:10
+type T :: *
+data T = A {a :: Int}
+ -- Defined at <interactive>:2:13
a :: Integer -- Defined at <interactive>:5:5
3
-data R = B {a :: Int} -- Defined at <interactive>:8:13
-data T = A {Ghci1.a :: Int} -- Defined at <interactive>:2:1
+type R :: *
+data R = B {a :: Int}
+ -- Defined at <interactive>:8:13
+type T :: *
+data T = A {Ghci1.a :: Int}
+ -- Defined at <interactive>:2:1
diff --git a/testsuite/tests/ghci/scripts/ghci051.stdout b/testsuite/tests/ghci/scripts/ghci051.stdout
index a3542869a5..9e77b017ba 100644
--- a/testsuite/tests/ghci/scripts/ghci051.stdout
+++ b/testsuite/tests/ghci/scripts/ghci051.stdout
@@ -1,9 +1,21 @@
-data T = C | D -- Defined at <interactive>:8:1
-type T' = Ghci1.T -- Defined at <interactive>:3:1
-data Ghci1.T = A | ... -- Defined at <interactive>:2:10
-data Ghci4.T = B | ... -- Defined at <interactive>:5:12
-data T = C | ... -- Defined at <interactive>:8:14
-data T = ... | D -- Defined at <interactive>:8:18
+type T :: *
+data T = C | D
+ -- Defined at <interactive>:8:1
+type T' :: *
+type T' = Ghci1.T
+ -- Defined at <interactive>:3:1
+type Ghci1.T :: *
+data Ghci1.T = A | ...
+ -- Defined at <interactive>:2:10
+type Ghci4.T :: *
+data Ghci4.T = B | ...
+ -- Defined at <interactive>:5:12
+type T :: *
+data T = C | ...
+ -- Defined at <interactive>:8:14
+type T :: *
+data T = ... | D
+ -- Defined at <interactive>:8:18
b :: T' -- Defined at <interactive>:4:5
c :: Ghci4.T -- Defined at <interactive>:7:5
d :: T -- Defined at <interactive>:9:5
diff --git a/testsuite/tests/ghci/scripts/ghci059.stdout b/testsuite/tests/ghci/scripts/ghci059.stdout
index 2fc93e6de5..e5cdb3d313 100644
--- a/testsuite/tests/ghci/scripts/ghci059.stdout
+++ b/testsuite/tests/ghci/scripts/ghci059.stdout
@@ -5,6 +5,7 @@ Please see section `The Coercible constraint`
of the user's guide for details.
-}
type role Coercible representational representational
-class Coercible a b => Coercible (a :: k) (b :: k)
+type Coercible :: forall k. k -> k -> Constraint
+class Coercible a b => Coercible a b
-- Defined in ‘GHC.Types’
coerce :: Coercible a b => a -> b -- Defined in ‘GHC.Prim’
diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout
index 4effb90a52..7a949cd465 100644
--- a/testsuite/tests/ghci/should_run/T10145.stdout
+++ b/testsuite/tests/ghci/should_run/T10145.stdout
@@ -1,4 +1,6 @@
-data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
+type (->) :: * -> * -> *
+data (->) a b
+ -- Defined in ‘GHC.Prim’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/should_run/T11825.stdout b/testsuite/tests/ghci/should_run/T11825.stdout
index 9ab7b1be0c..6ff7d89cfb 100644
--- a/testsuite/tests/ghci/should_run/T11825.stdout
+++ b/testsuite/tests/ghci/should_run/T11825.stdout
@@ -1,3 +1,4 @@
+type X :: ★ → ★ → Constraint
class X a b | a → b where
to ∷ a → b
{-# MINIMAL to #-}
diff --git a/testsuite/tests/ghci/should_run/T12525.stdout b/testsuite/tests/ghci/should_run/T12525.stdout
index 652a5cdd03..a00ffea4e3 100644
--- a/testsuite/tests/ghci/should_run/T12525.stdout
+++ b/testsuite/tests/ghci/should_run/T12525.stdout
@@ -1,3 +1,4 @@
x :: () = ()
y :: () = ()
+type Foo :: * -> Constraint
class Foo a
diff --git a/testsuite/tests/ghci/should_run/T9914.stdout b/testsuite/tests/ghci/should_run/T9914.stdout
index d9407d3877..5187084e71 100644
--- a/testsuite/tests/ghci/should_run/T9914.stdout
+++ b/testsuite/tests/ghci/should_run/T9914.stdout
@@ -1,5 +1,9 @@
1
2
2
-data T1 = MkT1 -- Defined at <interactive>:6:1
-data T2 = MkT2 -- Defined at <interactive>:8:2
+type T1 :: *
+data T1 = MkT1
+ -- Defined at <interactive>:6:1
+type T2 :: *
+data T2 = MkT2
+ -- Defined at <interactive>:8:2
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
index 28e71792ca..f0a5614560 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
@@ -2,30 +2,33 @@
ClosedFam3.hs-boot:7:1: error:
Type constructor ‘Foo’ has conflicting definitions in the module
and its hs-boot file
- Main module: type family Foo a :: *
- where
- Foo Int = Bool
- Foo Double = Char
- Boot file: type family Foo a :: *
- where Foo Int = Bool
+ Main module: type Foo :: * -> *
+ type family Foo a where
+ Foo Int = Bool
+ Foo Double = Char
+ Boot file: type Foo :: * -> *
+ type family Foo a where
+ Foo Int = Bool
ClosedFam3.hs-boot:10:1: error:
Type constructor ‘Bar’ has conflicting definitions in the module
and its hs-boot file
- Main module: type family Bar a :: *
- where
- Bar Int = Bool
- Bar Double = Double
- Boot file: type family Bar a :: *
- where
- Bar Int = Bool
- Bar Double = Char
+ Main module: type Bar :: * -> *
+ type family Bar a where
+ Bar Int = Bool
+ Bar Double = Double
+ Boot file: type Bar :: * -> *
+ type family Bar a where
+ Bar Int = Bool
+ Bar Double = Char
ClosedFam3.hs-boot:14:1: error:
Type constructor ‘Baz’ has conflicting definitions in the module
and its hs-boot file
- Main module: type family Baz a :: *
- where Baz Int = Bool
- Boot file: type family Baz (a :: k) :: *
- where Baz Int = Bool
+ Main module: type Baz :: * -> *
+ type family Baz a where
+ Baz Int = Bool
+ Boot file: type Baz :: forall k. k -> *
+ type family Baz a where
+ Baz Int = Bool
The types have different kinds
diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr
index 1bd21aed5e..2c296793dc 100644
--- a/testsuite/tests/indexed-types/should_fail/T9167.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr
@@ -1,5 +1,5 @@
-T9167.hs:5:1:
- The associated type ‘F’
- mentions none of the type or kind variables of the class ‘C a’
- In the class declaration for ‘C’
+T9167.hs:5:1: error:
+ • The associated type ‘F b’
+ mentions none of the type or kind variables of the class ‘C a’
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout
index cfed45f6f1..ff758c18bb 100644
--- a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout
+++ b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout
@@ -1,6 +1,9 @@
True
-data S = MkS {Ghci1.foo :: Int} -- Defined at <interactive>:3:16
+type S :: *
+data S = MkS {Ghci1.foo :: Int}
+ -- Defined at <interactive>:3:16
+type T :: * -> *
data T a = MkT {Ghci2.foo :: Bool, ...}
-- Defined at <interactive>:4:18
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 49ec1d111a..53d4f37acf 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -110,6 +110,7 @@
({ <no location info> }
[]))))]
[]
+ []
[])
,(TyClGroup
(NoExtField)
@@ -229,6 +230,7 @@
{Name: DumpRenamedAst.Peano})))))
(Nothing))))]
[]
+ []
[])
,(TyClGroup
(NoExtField)
@@ -273,6 +275,7 @@
{Name: GHC.Types.Type})))))))))
(Nothing))))]
[]
+ []
[({ DumpRenamedAst.hs:(18,1)-(19,45) }
(DataFamInstD
(NoExtField)
@@ -502,6 +505,7 @@
({ <no location info> }
[]))))]
[]
+ []
[])
,(TyClGroup
(NoExtField)
@@ -624,6 +628,7 @@
{Name: GHC.Types.Type})))))
(Nothing))))]
[]
+ []
[])]
[]
[]
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index 9e6b981bb8..29518e5118 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -91,6 +91,7 @@
({ <no location info> }
[]))))]
[]
+ []
[])]
[]
[]
diff --git a/testsuite/tests/polykinds/CuskFam.hs b/testsuite/tests/polykinds/CuskFam.hs
new file mode 100644
index 0000000000..c339dbcac0
--- /dev/null
+++ b/testsuite/tests/polykinds/CuskFam.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}
+-- {-# LANGUAGE CUSKs #-} -- enabled by default
+
+module CuskFam where
+
+type family F a -- non-injective
+
+type family X :: F a
+ -- Used to fail with:
+ --
+ -- • Couldn't match expected kind ‘F a1’ with actual kind ‘F a’
+ -- NB: ‘F’ is a non-injective type family
+ -- The type variable ‘a1’ is ambiguous
+ -- • In the type family declaration for ‘X’
+ --
+ -- See Note [Unifying implicit CUSK variables] in TcHsType
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 6345b228e4..74ab266308 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -214,3 +214,4 @@ test('T16221a', normal, compile_fail, [''])
test('T16342', normal, compile, [''])
test('T16263', normal, compile_fail, [''])
test('T16902', normal, compile_fail, [''])
+test('CuskFam', normal, compile, [''])
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index b9ba174519..ef4b09fd3a 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -15,31 +15,39 @@ RnFail055.hs-boot:4:1: error:
RnFail055.hs-boot:6:1: error:
Type constructor ‘S1’ has conflicting definitions in the module
and its hs-boot file
- Main module: type S1 a b = (a, b)
- Boot file: type S1 a b c = (a, b)
+ Main module: type S1 :: * -> * -> *
+ type S1 a b = (a, b)
+ Boot file: type S1 :: * -> * -> * -> *
+ type S1 a b c = (a, b)
The types have different kinds
RnFail055.hs-boot:8:1: error:
Type constructor ‘S2’ has conflicting definitions in the module
and its hs-boot file
- Main module: type S2 a b = forall a1. (a1, b)
- Boot file: type S2 a b = forall b1. (a, b1)
+ Main module: type S2 :: * -> * -> *
+ type S2 a b = forall a1. (a1, b)
+ Boot file: type S2 :: * -> * -> *
+ type S2 a b = forall b1. (a, b1)
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
RnFail055.hs-boot:12:1: error:
Type constructor ‘T1’ has conflicting definitions in the module
and its hs-boot file
- Main module: data T1 a b = T1 [b] [a]
- Boot file: data T1 a b = T1 [a] [b]
+ Main module: type T1 :: * -> * -> *
+ data T1 a b = T1 [b] [a]
+ Boot file: type T1 :: * -> * -> *
+ data T1 a b = T1 [a] [b]
The constructors do not match: The types for ‘T1’ differ
RnFail055.hs-boot:14:1: error:
Type constructor ‘T2’ has conflicting definitions in the module
and its hs-boot file
Main module: type role T2 representational nominal
+ type T2 :: * -> * -> *
data Eq b => T2 a b = T2 a
Boot file: type role T2 nominal phantom
+ type T2 :: * -> * -> *
data Eq a => T2 a b = T2 a
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
@@ -54,16 +62,20 @@ RnFail055.hs-boot:17:12: error:
RnFail055.hs-boot:21:1: error:
Type constructor ‘T5’ has conflicting definitions in the module
and its hs-boot file
- Main module: data T5 a = T5 {field5 :: a}
- Boot file: data T5 a = T5 a
+ Main module: type T5 :: * -> *
+ data T5 a = T5 {field5 :: a}
+ Boot file: type T5 :: * -> *
+ data T5 a = T5 a
The constructors do not match:
The record label lists for ‘T5’ differ
RnFail055.hs-boot:23:1: error:
Type constructor ‘T6’ has conflicting definitions in the module
and its hs-boot file
- Main module: data T6 = T6 Int
- Boot file: data T6 = T6 !Int
+ Main module: type T6 :: *
+ data T6 = T6 Int
+ Boot file: type T6 :: *
+ data T6 = T6 !Int
The constructors do not match:
The strictness annotations for ‘T6’ differ
@@ -71,8 +83,10 @@ RnFail055.hs-boot:25:1: error:
Type constructor ‘T7’ has conflicting definitions in the module
and its hs-boot file
Main module: type role T7 phantom
+ type T7 :: * -> *
data T7 a = forall a1. T7 a1
- Boot file: data T7 a = forall b. T7 a
+ Boot file: type T7 :: * -> *
+ data T7 a = forall b. T7 a
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
The constructors do not match: The types for ‘T7’ differ
@@ -83,11 +97,13 @@ RnFail055.hs-boot:27:22: error:
RnFail055.hs-boot:28:1: error:
Class ‘C2’ has conflicting definitions in the module
and its hs-boot file
- Main module: class C2 a b where
+ Main module: type C2 :: * -> * -> Constraint
+ class C2 a b where
m2 :: a -> b
m2' :: a -> b
{-# MINIMAL m2, m2' #-}
- Boot file: class C2 a b where
+ Boot file: type C2 :: * -> * -> Constraint
+ class C2 a b where
m2 :: a -> b
{-# MINIMAL m2 #-}
The methods do not match: There are different numbers of methods
@@ -96,6 +112,8 @@ RnFail055.hs-boot:28:1: error:
RnFail055.hs-boot:29:1: error:
Class ‘C3’ has conflicting definitions in the module
and its hs-boot file
- Main module: class (Eq a, Ord a) => C3 a
- Boot file: class (Ord a, Eq a) => C3 a
+ Main module: type C3 :: * -> Constraint
+ class (Eq a, Ord a) => C3 a
+ Boot file: type C3 :: * -> Constraint
+ class (Ord a, Eq a) => C3 a
The class constraints do not match
diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr
index d1872f3350..ec3bff4182 100644
--- a/testsuite/tests/roles/should_fail/Roles12.stderr
+++ b/testsuite/tests/roles/should_fail/Roles12.stderr
@@ -3,7 +3,9 @@ Roles12.hs:5:1: error:
Type constructor ‘T’ has conflicting definitions in the module
and its hs-boot file
Main module: type role T phantom
+ type T :: * -> *
+ data T a
+ Boot file: type T :: * -> *
data T a
- Boot file: data T a
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
diff --git a/testsuite/tests/roles/should_fail/T9204.stderr b/testsuite/tests/roles/should_fail/T9204.stderr
index 998f17c284..0e8cbf4524 100644
--- a/testsuite/tests/roles/should_fail/T9204.stderr
+++ b/testsuite/tests/roles/should_fail/T9204.stderr
@@ -3,7 +3,9 @@ T9204.hs:6:1: error:
Type constructor ‘D’ has conflicting definitions in the module
and its hs-boot file
Main module: type role D phantom
+ type D :: * -> *
+ data D a
+ Boot file: type D :: * -> *
data D a
- Boot file: data D a
The roles do not match.
Roles on abstract types default to ‘representational’ in boot files.
diff --git a/testsuite/tests/saks/should_compile/T16721.script b/testsuite/tests/saks/should_compile/T16721.script
new file mode 100644
index 0000000000..1e747be98e
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16721.script
@@ -0,0 +1,4 @@
+:set -XStandaloneKindSignatures -XNoStarIsType
+import Data.Kind (Type)
+type T :: (Type -> Type) -> Type; data T a
+:info T
diff --git a/testsuite/tests/saks/should_compile/T16721.stdout b/testsuite/tests/saks/should_compile/T16721.stdout
new file mode 100644
index 0000000000..8dce9caa1a
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16721.stdout
@@ -0,0 +1,4 @@
+type role T phantom
+type T :: (Type -> Type) -> Type
+data T a
+ -- Defined at <interactive>:3:35
diff --git a/testsuite/tests/saks/should_compile/T16723.hs b/testsuite/tests/saks/should_compile/T16723.hs
new file mode 100644
index 0000000000..2ba216a93d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16723.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module T16723 where
+
+import Data.Kind
+
+type D :: forall a. Type
+data D
diff --git a/testsuite/tests/saks/should_compile/T16724.hs b/testsuite/tests/saks/should_compile/T16724.hs
new file mode 100644
index 0000000000..3ab5d0761a
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16724.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T16724 where
+
+import Data.Kind
+
+type T1 :: forall k (a :: k). Type
+type family T1
+
+-- type T2 :: forall {k} (a :: k). Type
+type T2 :: forall a. Type
+type family T2
diff --git a/testsuite/tests/saks/should_compile/T16724.script b/testsuite/tests/saks/should_compile/T16724.script
new file mode 100644
index 0000000000..f5681b86ca
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16724.script
@@ -0,0 +1,5 @@
+:set -fprint-explicit-kinds -fprint-explicit-foralls -XNoStarIsType
+:load T16724.hs
+:info T1
+:info T2
+ -- must have the same arity!
diff --git a/testsuite/tests/saks/should_compile/T16724.stdout b/testsuite/tests/saks/should_compile/T16724.stdout
new file mode 100644
index 0000000000..099371c58d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16724.stdout
@@ -0,0 +1,6 @@
+type T1 :: forall k (a :: k). Type
+type family T1 @k @a
+ -- Defined at T16724.hs:11:1
+type T2 :: forall {k} (a :: k). Type
+type family T2 @{k} @a
+ -- Defined at T16724.hs:15:1
diff --git a/testsuite/tests/saks/should_compile/T16726.hs b/testsuite/tests/saks/should_compile/T16726.hs
new file mode 100644
index 0000000000..e1a748d0a0
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16726.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T16726 where
+
+import Data.Kind
+
+type D :: forall k. k -> Type
+data D :: forall j. j -> Type
+
+type DF :: forall k. k -> Type
+data family DF :: forall j. j -> Type
+
+type T :: forall k. k -> Type
+type family T :: forall j. j -> Type
diff --git a/testsuite/tests/saks/should_compile/T16731.hs b/testsuite/tests/saks/should_compile/T16731.hs
new file mode 100644
index 0000000000..c2051f678d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16731.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module T16731 where
+
+import Data.Kind
+
+class C (a :: Type) (b :: Type)
+
+type T :: forall a. a -> Type
+data T (x :: z) deriving (C z)
diff --git a/testsuite/tests/saks/should_compile/T16756a.hs b/testsuite/tests/saks/should_compile/T16756a.hs
new file mode 100644
index 0000000000..f85c2ecbc9
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16756a.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T16756a where
+
+import Data.Kind (Type)
+
+type T :: Type -> Type
+data family T
+ -- We do /not/ need to write:
+ -- data family T a
+ -- See https://gitlab.haskell.org/ghc/ghc/issues/16756#note_203567
diff --git a/testsuite/tests/saks/should_compile/T16758.hs b/testsuite/tests/saks/should_compile/T16758.hs
new file mode 100644
index 0000000000..2798156f3c
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T16758.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ConstrainedClassMethods #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ExplicitForAll #-}
+
+module T16758 where
+
+import Data.Kind
+
+type C :: forall (a :: Type) -> a ~ Int => Constraint
+class C a where
+ f :: C a => a -> Int
diff --git a/testsuite/tests/saks/should_compile/T17164.hs b/testsuite/tests/saks/should_compile/T17164.hs
new file mode 100644
index 0000000000..0f9d9e440f
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T17164.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -ddump-splices #-}
+
+module T17164 where
+
+import Data.Kind
+
+$([d| type T :: forall k -> k -> Type
+ type family T :: forall k -> k -> Type
+ |])
diff --git a/testsuite/tests/saks/should_compile/T17164.stderr b/testsuite/tests/saks/should_compile/T17164.stderr
new file mode 100644
index 0000000000..5b1fdbf0fc
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/T17164.stderr
@@ -0,0 +1,7 @@
+T17164.hs:(12,3)-(14,6): Splicing declarations
+ [d| type T :: forall k -> k -> Type
+
+ type family T :: forall k -> k -> Type |]
+ ======>
+ type T :: forall k -> k -> Type
+ type family T :: forall k -> k -> Type
diff --git a/testsuite/tests/saks/should_compile/all.T b/testsuite/tests/saks/should_compile/all.T
new file mode 100644
index 0000000000..73f608c6dd
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/all.T
@@ -0,0 +1,49 @@
+setTestOpts(normalise_version('base','ghc-prim'))
+
+test('saks001', normal, compile, [''])
+test('saks002', normal, compile, [''])
+test('saks003', normal, compile, [''])
+test('saks004', normal, compile, [''])
+test('saks005', normal, compile, [''])
+test('saks006', normal, compile, [''])
+test('saks007', normal, compile, [''])
+test('saks008', normal, compile, [''])
+test('saks009', normal, compile, [''])
+test('saks010', normal, compile, [''])
+test('saks014', normal, compile, [''])
+test('saks015', normal, compile, [''])
+test('saks016', normal, compile, [''])
+test('saks017', normal, compile, [''])
+test('saks018', normal, compile, [''])
+test('saks019', normal, compile, [''])
+test('saks020', normal, compile, [''])
+test('saks021', normal, compile, [''])
+test('saks023', normal, ghci_script, ['saks023.script'])
+test('saks024', normal, compile, [''])
+test('saks025', extra_files(['saks025.hs']), ghci_script, ['saks025.script'])
+test('saks026', normal, compile, [''])
+test('saks029', normal, compile, [''])
+test('saks030', normal, compile, [''])
+test('saks031', normal, compile, [''])
+test('saks032', normal, compile, [''])
+test('saks033', normal, compile, [''])
+test('saks034', extra_files(['saks034.hs']), ghci_script, ['saks034.script'])
+test('saks035', extra_files(['saks035.hs']), ghci_script, ['saks035.script'])
+test('saks036', normal, compile, [''])
+test('T16723', normal, compile, [''])
+test('T16724', extra_files(['T16724.hs']), ghci_script, ['T16724.script'])
+test('T16726', normal, compile, [''])
+test('T16731', normal, compile, [''])
+test('T16758', expect_broken(16758), compile, [''])
+test('T16721', normal, ghci_script, ['T16721.script'])
+test('T16756a', normal, compile, [''])
+
+# We omit 'profasm' because it fails with:
+# Cannot load -prof objects when GHC is built with -dynamic
+# To fix this, either:
+# (1) Use -fexternal-interpreter, or
+# (2) Build the program twice: once with -dynamic, and then
+# with -prof using -osuf to set a different object file suffix.
+test('saks027', omit_ways(['profasm']), compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('saks028', omit_ways(['profasm']), compile, [''])
+test('T17164', omit_ways(['profasm']), compile, ['-v0 -ddump-splices -dsuppress-uniques'])
diff --git a/testsuite/tests/saks/should_compile/saks001.hs b/testsuite/tests/saks/should_compile/saks001.hs
new file mode 100644
index 0000000000..425a992adb
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks001.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_001 where
+
+import Data.Kind (Type)
+
+type MonoTagged :: Type -> Type -> Type
+data MonoTagged t x = MonoTagged x
diff --git a/testsuite/tests/saks/should_compile/saks002.hs b/testsuite/tests/saks/should_compile/saks002.hs
new file mode 100644
index 0000000000..3dcf49deda
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks002.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, PolyKinds, ExplicitForAll #-}
+
+module SAKS_002 where
+
+type Id :: forall k. k -> k
+type family Id x where
+ Id x = x
diff --git a/testsuite/tests/saks/should_compile/saks003.hs b/testsuite/tests/saks/should_compile/saks003.hs
new file mode 100644
index 0000000000..778862c918
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks003.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilyDependencies, PolyKinds, ExplicitForAll #-}
+
+module SAKS_003 where
+
+type InjectiveId :: forall k. k -> k
+type family InjectiveId x = r | r -> x where
+ InjectiveId x = x
diff --git a/testsuite/tests/saks/should_compile/saks004.hs b/testsuite/tests/saks/should_compile/saks004.hs
new file mode 100644
index 0000000000..1a4cdbafd3
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks004.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses, PolyKinds, ConstraintKinds #-}
+
+module SAKS_004 where
+
+import Data.Kind (Type, Constraint)
+
+type C :: (k -> Type) -> k -> Constraint
+class C a b where
+ f :: a b
diff --git a/testsuite/tests/saks/should_compile/saks005.hs b/testsuite/tests/saks/should_compile/saks005.hs
new file mode 100644
index 0000000000..ed85eca41d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks005.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE GADTs, PolyKinds, ExplicitForAll #-}
+
+module SAKS_005 where
+
+import Data.Kind (Type, Constraint)
+
+type TypeRep :: forall k. k -> Type
+data TypeRep a where
+ TyInt :: TypeRep Int
+ TyMaybe :: TypeRep Maybe
+ TyApp :: TypeRep a -> TypeRep b -> TypeRep (a b)
diff --git a/testsuite/tests/saks/should_compile/saks006.hs b/testsuite/tests/saks/should_compile/saks006.hs
new file mode 100644
index 0000000000..99e6b3aa5c
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks006.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies, PolyKinds, ConstraintKinds #-}
+
+module SAKS_006 where
+
+import Data.Kind (Type, Constraint)
+
+type C :: (k -> Type) -> k -> Constraint
+type T :: k -> Type
+
+class C a b
+data T a
+
+-- type D :: j -> Constraint -- #16571
+type D :: Type -> Constraint
+type D = C T
+
+-- type DF :: j -> Constraint -- #16571
+type DF :: Type -> Constraint
+type family DF where
+ DF = C T
diff --git a/testsuite/tests/saks/should_compile/saks007.hs b/testsuite/tests/saks/should_compile/saks007.hs
new file mode 100644
index 0000000000..7f6869576b
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks007.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, GADTs, PolyKinds, DataKinds, ExplicitForAll #-}
+
+-- See also: saks007_fail.hs
+module SAKS_007 where
+
+import Data.Kind (Type, Constraint)
+
+type family F a where { F Type = True; F _ = False }
+type family G a where { G Type = False; G _ = True }
+
+type X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type
+data X a b where
+ MkX :: X Integer Maybe -- OK: F Type ~ G (Type -> Type)
+ -- True ~ True
diff --git a/testsuite/tests/saks/should_compile/saks008.hs b/testsuite/tests/saks/should_compile/saks008.hs
new file mode 100644
index 0000000000..ce7a8646d0
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks008.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds #-}
+
+module SAKS_008 where
+
+import Data.Proxy (Proxy)
+import Data.Kind (Type)
+
+-- Test inferred type variables.
+-- T :: forall {k} (a :: k). Proxy a -> Type
+type T :: Proxy a -> Type
+data T x = MkT
diff --git a/testsuite/tests/saks/should_compile/saks009.hs b/testsuite/tests/saks/should_compile/saks009.hs
new file mode 100644
index 0000000000..f2cccdddfd
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks009.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ExplicitForAll, PolyKinds #-}
+
+module SAKS_009 where
+
+import Data.Kind (Type)
+
+type Q :: forall k -> k -> Type
+data Q j (a :: j)
diff --git a/testsuite/tests/saks/should_compile/saks010.hs b/testsuite/tests/saks/should_compile/saks010.hs
new file mode 100644
index 0000000000..20dd2413b0
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks010.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-}
+
+module SAKS_010 where
+
+import Data.Kind (Type)
+
+type W :: forall (a :: forall k. k -> Type) -> a Int -> a Maybe -> Type
+data W x (y :: x Int) (z :: x Maybe)
diff --git a/testsuite/tests/saks/should_compile/saks014.hs b/testsuite/tests/saks/should_compile/saks014.hs
new file mode 100644
index 0000000000..6e0f4a56f6
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks014.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+
+module SAKS_014 where
+
+import Data.Kind (Type)
+
+type T :: (k -> Type) -> (k -> Type)
+data T m a = MkT (m a) (T Maybe (m a))
diff --git a/testsuite/tests/saks/should_compile/saks015.hs b/testsuite/tests/saks/should_compile/saks015.hs
new file mode 100644
index 0000000000..a8cf7204f1
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks015.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_015 where
+
+import Data.Kind (Type)
+
+type T :: forall k -> k -> Type
+data T (k :: Type) (a :: k)
diff --git a/testsuite/tests/saks/should_compile/saks016.hs b/testsuite/tests/saks/should_compile/saks016.hs
new file mode 100644
index 0000000000..dca8ce7700
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks016.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, RankNTypes #-}
+
+module SAKS_016 where
+
+import Data.Kind (Type)
+
+type T :: forall k. k -> forall j. j -> Type
+data T (x :: hk) (y :: hj)
diff --git a/testsuite/tests/saks/should_compile/saks017.hs b/testsuite/tests/saks/should_compile/saks017.hs
new file mode 100644
index 0000000000..3b69b27d7f
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks017.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, ExplicitForAll #-}
+
+module SAKS_017 where
+
+import Data.Kind (Type)
+
+type family F a where
+ F Bool = Type
+ F (f a) = F a
+
+type family G a where
+ G Int = Type
+
+data family T :: F (Maybe Bool) -> t
+data instance T (a :: G Int) = MkT a
diff --git a/testsuite/tests/saks/should_compile/saks018.hs b/testsuite/tests/saks/should_compile/saks018.hs
new file mode 100644
index 0000000000..a24a19e117
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks018.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_018 where
+
+import Data.Kind (Type)
+
+type T :: forall k -> k -> Type
+data T k (x :: hk)
diff --git a/testsuite/tests/saks/should_compile/saks019.hs b/testsuite/tests/saks/should_compile/saks019.hs
new file mode 100644
index 0000000000..6e97db5c49
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks019.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll #-}
+
+module SAKS_019 where
+
+import Data.Kind (Type)
+
+data P (a :: k)
+
+type T :: forall a. P a -> Type
+data T (y :: P (b :: j))
diff --git a/testsuite/tests/saks/should_compile/saks020.hs b/testsuite/tests/saks/should_compile/saks020.hs
new file mode 100644
index 0000000000..93cd4b734c
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks020.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, RankNTypes #-}
+
+module SAKS_020 where
+
+import Data.Kind (Type)
+
+type T :: forall k. k -> forall j. j -> Type
+data T (x :: hk) :: hj -> Type
diff --git a/testsuite/tests/saks/should_compile/saks021.hs b/testsuite/tests/saks/should_compile/saks021.hs
new file mode 100644
index 0000000000..00bf9f8918
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks021.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_021 where
+
+import Data.Kind (Type)
+
+type T :: forall k -> forall (xx :: k) -> Type
+data T k (x :: hk)
diff --git a/testsuite/tests/saks/should_compile/saks023.script b/testsuite/tests/saks/should_compile/saks023.script
new file mode 100644
index 0000000000..06d85eb38b
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks023.script
@@ -0,0 +1,5 @@
+:set -XStandaloneKindSignatures -XExplicitForAll -XPolyKinds -XNoStarIsType
+import Data.Kind (Type)
+type T :: forall (x :: Type) -> Type; data T a
+:kind T
+ -- must output forall x, not forall a!
diff --git a/testsuite/tests/saks/should_compile/saks023.stdout b/testsuite/tests/saks/should_compile/saks023.stdout
new file mode 100644
index 0000000000..051268aa78
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks023.stdout
@@ -0,0 +1 @@
+T :: forall x -> Type
diff --git a/testsuite/tests/saks/should_compile/saks024.hs b/testsuite/tests/saks/should_compile/saks024.hs
new file mode 100644
index 0000000000..b58f49da5d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks024.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, TypeFamilies #-}
+
+module SAKS_024 where
+
+import Data.Kind
+
+data P (a :: k) = MkP
+
+type C :: i -> Constraint
+class C (p :: j) where
+ type F :: j
+
+f :: P k -> P (F :: k)
+f _ = MkP
diff --git a/testsuite/tests/saks/should_compile/saks025.hs b/testsuite/tests/saks/should_compile/saks025.hs
new file mode 100644
index 0000000000..dc51abd3f1
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks025.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}
+
+module SAKS_025 where
+
+import Data.Kind
+
+data P (a :: k) = MkP
+
+type C :: j -> Constraint
+class C a where
+ type T a b (c :: P p)
diff --git a/testsuite/tests/saks/should_compile/saks025.script b/testsuite/tests/saks/should_compile/saks025.script
new file mode 100644
index 0000000000..e19353e46d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks025.script
@@ -0,0 +1,3 @@
+:set -XNoStarIsType
+:load saks025.hs
+:kind T
diff --git a/testsuite/tests/saks/should_compile/saks025.stdout b/testsuite/tests/saks/should_compile/saks025.stdout
new file mode 100644
index 0000000000..3eb0cd7c30
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks025.stdout
@@ -0,0 +1 @@
+T :: forall k j (p :: k). j -> Type -> P p -> Type
diff --git a/testsuite/tests/saks/should_compile/saks026.hs b/testsuite/tests/saks/should_compile/saks026.hs
new file mode 100644
index 0000000000..a8a3967a0d
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks026.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, DataKinds, PolyKinds, GADTs, TypeFamilies #-}
+
+module SAKS_026 where
+
+import Data.Kind
+
+data HigherRank (f :: forall x. x -> Type)
+
+data P :: forall k. k -> Type
+
+type PSyn :: forall k. k -> Type
+type PSyn = (P :: forall k. k -> Type)
+
+type Test = HigherRank PSyn
diff --git a/testsuite/tests/saks/should_compile/saks027.hs b/testsuite/tests/saks/should_compile/saks027.hs
new file mode 100644
index 0000000000..736def1d68
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks027.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module SAKS_027 where
+
+import Data.Kind
+
+$([d| type U :: Type
+ data U = MkU
+ |])
diff --git a/testsuite/tests/saks/should_compile/saks027.stderr b/testsuite/tests/saks/should_compile/saks027.stderr
new file mode 100644
index 0000000000..730b1cfde6
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks027.stderr
@@ -0,0 +1,7 @@
+saks027.hs:(8,3)-(10,6): Splicing declarations
+ [d| type U :: Type
+
+ data U = MkU |]
+ ======>
+ type U :: Type
+ data U = MkU
diff --git a/testsuite/tests/saks/should_compile/saks028.hs b/testsuite/tests/saks/should_compile/saks028.hs
new file mode 100644
index 0000000000..9d15db593c
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks028.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module SAKS_028 where
+
+import Data.Kind
+import Language.Haskell.TH hiding (Type)
+
+type Functor' :: (Type -> Type) -> Constraint
+class Functor' f
+
+do sig <- reifyType ('' Functor')
+ runIO $ putStrLn $ pprint sig
+ return []
diff --git a/testsuite/tests/saks/should_compile/saks028.stderr b/testsuite/tests/saks/should_compile/saks028.stderr
new file mode 100644
index 0000000000..92ed23779c
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks028.stderr
@@ -0,0 +1 @@
+(* -> *) -> Constraint
diff --git a/testsuite/tests/saks/should_compile/saks029.hs b/testsuite/tests/saks/should_compile/saks029.hs
new file mode 100644
index 0000000000..ca2f28bce9
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks029.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds, RankNTypes, TypeFamilies #-}
+
+module SAKS_029 where
+
+import Data.Kind
+import Data.Proxy
+import Data.Type.Bool
+
+type IfK :: forall j m n. forall (e :: Proxy (j :: Bool)) -> m -> n -> If j m n
+type family IfK e f g where
+ IfK (_ :: Proxy True) f _ = f
+ IfK (_ :: Proxy False) _ g = g
diff --git a/testsuite/tests/saks/should_compile/saks030.hs b/testsuite/tests/saks/should_compile/saks030.hs
new file mode 100644
index 0000000000..93e414fbed
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks030.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds, RankNTypes, TypeFamilies,
+ TypeApplications, TypeOperators, GADTs #-}
+
+module SAKS_030 where
+
+import Data.Kind
+import Data.Type.Equality
+
+type T1 :: forall k (a :: k). Bool
+type T2 :: k -> Bool
+
+type family T1 where
+ T1 @Bool @True = False
+ T1 @Bool @False = True
+
+type family T2 a where
+ T2 True = False
+ T2 False = True
+
+type SBool :: Bool -> Type
+data SBool b where
+ STrue :: SBool True
+ SFalse :: SBool False
+
+proof_t1_eq_t2 :: SBool b -> T1 @Bool @b :~: T2 b
+proof_t1_eq_t2 STrue = Refl
+proof_t1_eq_t2 SFalse = Refl
diff --git a/testsuite/tests/saks/should_compile/saks031.hs b/testsuite/tests/saks/should_compile/saks031.hs
new file mode 100644
index 0000000000..a737d6ddc7
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks031.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, MagicHash #-}
+
+module SAKS_031 where
+
+import Data.Kind
+import GHC.Exts
+
+type T1 :: Type -> TYPE 'IntRep
+data family T1
+
+newtype instance T1 a = MkT1 Int#
+
+type T2 :: TYPE IntRep
+newtype T2 = MkT2 Int#
diff --git a/testsuite/tests/saks/should_compile/saks032.hs b/testsuite/tests/saks/should_compile/saks032.hs
new file mode 100644
index 0000000000..612c66d8fc
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks032.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, RankNTypes #-}
+
+module SAKS_032 where
+
+import Data.Kind
+import Data.Proxy
+
+type Const :: Type -> forall k. k -> Type
+data Const a b = Const a
+
+type F :: Type -> Type -> forall k. k -> Type
+type family F a b :: forall k. k -> Type where
+ F () () = Proxy
+ F a b = Const (a,b)
+
+type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type
+type family F1 a b
+
+type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type
+type family F2 a b :: forall r2. (r1, r2) -> Type
diff --git a/testsuite/tests/saks/should_compile/saks033.hs b/testsuite/tests/saks/should_compile/saks033.hs
new file mode 100644
index 0000000000..cd6451dff0
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks033.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds, MultiParamTypeClasses, TypeFamilies, TypeApplications #-}
+
+module SAKS_033 where
+
+import Data.Kind
+import Data.Proxy
+
+type C :: i -> Constraint
+class C (a :: zzz) where
+ type F (a :: zzz) :: Type
+
+type T = F @Bool True
diff --git a/testsuite/tests/saks/should_compile/saks034.hs b/testsuite/tests/saks/should_compile/saks034.hs
new file mode 100644
index 0000000000..1288b665fe
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks034.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}
+
+module SAKS_034 where
+
+import Data.Kind
+
+type C :: j -> Constraint
+class C (a :: k) where
+ -- T :: forall j -> j -> Type
+ type T k (b :: k) :: Type
diff --git a/testsuite/tests/saks/should_compile/saks034.script b/testsuite/tests/saks/should_compile/saks034.script
new file mode 100644
index 0000000000..23dc6dfae8
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks034.script
@@ -0,0 +1,4 @@
+:set -XNoStarIsType
+:load saks034.hs
+:kind C
+:kind T
diff --git a/testsuite/tests/saks/should_compile/saks034.stdout b/testsuite/tests/saks/should_compile/saks034.stdout
new file mode 100644
index 0000000000..9877dc5d39
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks034.stdout
@@ -0,0 +1,2 @@
+C :: j -> Constraint
+T :: forall j -> j -> Type
diff --git a/testsuite/tests/saks/should_compile/saks035.hs b/testsuite/tests/saks/should_compile/saks035.hs
new file mode 100644
index 0000000000..e4b5fe7d66
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks035.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}
+
+module SAKS_035 where
+
+import Data.Proxy
+import Data.Kind
+
+type C :: Proxy i -> Constraint
+class C (a :: Proxy z) where
+ -- F :: k -> Type
+ type F z
diff --git a/testsuite/tests/saks/should_compile/saks035.script b/testsuite/tests/saks/should_compile/saks035.script
new file mode 100644
index 0000000000..c51128f0da
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks035.script
@@ -0,0 +1,4 @@
+:set -XNoStarIsType
+:load saks035.hs
+:kind C
+:kind F
diff --git a/testsuite/tests/saks/should_compile/saks035.stdout b/testsuite/tests/saks/should_compile/saks035.stdout
new file mode 100644
index 0000000000..52193a3ff4
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks035.stdout
@@ -0,0 +1,2 @@
+C :: forall k (i :: k). Proxy i -> Constraint
+F :: k -> Type
diff --git a/testsuite/tests/saks/should_compile/saks036.hs b/testsuite/tests/saks/should_compile/saks036.hs
new file mode 100644
index 0000000000..76d3acd340
--- /dev/null
+++ b/testsuite/tests/saks/should_compile/saks036.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, PolyKinds, RankNTypes, DataKinds #-}
+
+module SAKS_036 where
+
+import Data.Kind
+
+type C :: forall (k :: Type). k -> Constraint
+class C (a :: (j :: Star)) where
+ type F j
+
+type family Star where Star = Type
diff --git a/testsuite/tests/saks/should_fail/T16722.hs b/testsuite/tests/saks/should_fail/T16722.hs
new file mode 100644
index 0000000000..fdc8b8de21
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16722.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE NoPolyKinds #-}
+
+module T16722 where
+
+import Data.Kind
+
+type D :: k -> Type
+data D a
diff --git a/testsuite/tests/saks/should_fail/T16722.stderr b/testsuite/tests/saks/should_fail/T16722.stderr
new file mode 100644
index 0000000000..0b50bb868d
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16722.stderr
@@ -0,0 +1,5 @@
+
+T16722.hs:8:11: error:
+ Unexpected kind variable ‘k’
+ Perhaps you intended to use PolyKinds
+ In the standalone kind signature for D
diff --git a/testsuite/tests/saks/should_fail/T16725.hs b/testsuite/tests/saks/should_fail/T16725.hs
new file mode 100644
index 0000000000..904cabe083
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16725.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16725 where
+
+import Data.Kind (Type)
+
+type W :: Type
diff --git a/testsuite/tests/saks/should_fail/T16725.stderr b/testsuite/tests/saks/should_fail/T16725.stderr
new file mode 100644
index 0000000000..4fed187f73
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16725.stderr
@@ -0,0 +1,3 @@
+
+T16725.hs:8:6: error:
+ The standalone kind signature for ‘W’ lacks an accompanying binding
diff --git a/testsuite/tests/saks/should_fail/T16727a.hs b/testsuite/tests/saks/should_fail/T16727a.hs
new file mode 100644
index 0000000000..c258a4cc81
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16727a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module T16727a where
+
+type T1 :: T2
+data T1
+
+type T2 :: T1
+data T2
diff --git a/testsuite/tests/saks/should_fail/T16727a.stderr b/testsuite/tests/saks/should_fail/T16727a.stderr
new file mode 100644
index 0000000000..9d0f3e11d7
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16727a.stderr
@@ -0,0 +1,5 @@
+
+T16727a.hs:8:12: error:
+ • Type constructor ‘T1’ cannot be used here
+ (it is defined and used in the same recursive group)
+ • In a standalone kind signature for ‘T2’: T1
diff --git a/testsuite/tests/saks/should_fail/T16727b.hs b/testsuite/tests/saks/should_fail/T16727b.hs
new file mode 100644
index 0000000000..eb8fa62c50
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16727b.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module T16727b where
+
+type T :: T
+data T
diff --git a/testsuite/tests/saks/should_fail/T16727b.stderr b/testsuite/tests/saks/should_fail/T16727b.stderr
new file mode 100644
index 0000000000..0a50ffe2e4
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16727b.stderr
@@ -0,0 +1,5 @@
+
+T16727b.hs:5:11: error:
+ • Type constructor ‘T’ cannot be used here
+ (it is defined and used in the same recursive group)
+ • In a standalone kind signature for ‘T’: T
diff --git a/testsuite/tests/saks/should_fail/T16756b.hs b/testsuite/tests/saks/should_fail/T16756b.hs
new file mode 100644
index 0000000000..8b71a67dad
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16756b.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module T16756b where
+
+import Data.Kind (Type)
+
+type T :: Type -> Type
+data T
+ -- We must write:
+ -- data T a
+ -- See https://gitlab.haskell.org/ghc/ghc/issues/16756#note_203567
diff --git a/testsuite/tests/saks/should_fail/T16756b.stderr b/testsuite/tests/saks/should_fail/T16756b.stderr
new file mode 100644
index 0000000000..d8324628d2
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16756b.stderr
@@ -0,0 +1,4 @@
+
+T16756b.hs:8:1: error:
+ • Expected a type, but found something with kind ‘* -> *’
+ • In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/T16826.hs b/testsuite/tests/saks/should_fail/T16826.hs
new file mode 100644
index 0000000000..60f305edef
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16826.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T16826 where
+
+import Data.Kind
+
+type family Id (x :: Type) :: Type where
+ Id x = x
+
+type C :: Type -> Id Constraint
+class C a
diff --git a/testsuite/tests/saks/should_fail/T16826.stderr b/testsuite/tests/saks/should_fail/T16826.stderr
new file mode 100644
index 0000000000..c2272806c9
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/T16826.stderr
@@ -0,0 +1,5 @@
+
+T16826.hs:14:1: error:
+ • Kind signature on a class must end with Constraint
+ unobscured by type families
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/saks/should_fail/all.T b/testsuite/tests/saks/should_fail/all.T
new file mode 100644
index 0000000000..82ae24181c
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/all.T
@@ -0,0 +1,32 @@
+test('saks007_fail', normal, compile_fail, [''])
+test('saks_fail001', normal, compile_fail, [''])
+test('saks_fail002', normal, compile_fail, [''])
+test('saks_fail003', normal, compile_fail, [''])
+test('saks_fail004', normal, compile_fail, [''])
+test('saks_fail005', normal, compile_fail, [''])
+test('saks_fail006', normal, compile_fail, [''])
+test('saks_fail007', normal, compile_fail, [''])
+test('saks_fail008', normal, compile_fail, [''])
+test('saks_fail009', normal, compile_fail, [''])
+test('saks_fail010', normal, compile_fail, [''])
+test('saks_fail011', normal, compile_fail, [''])
+test('saks_fail012', normal, compile_fail, [''])
+test('saks_fail013', normal, compile_fail, [''])
+test('saks_fail014', normal, compile_fail, [''])
+test('saks_fail015', normal, compile_fail, [''])
+test('saks_fail016', normal, compile_fail, [''])
+test('saks_fail017', normal, compile_fail, [''])
+test('saks_fail018', normal, compile_fail, [''])
+test('saks_fail019', normal, compile_fail, [''])
+test('saks_fail020', normal, compile_fail, [''])
+test('saks_fail021', normal, compile_fail, [''])
+test('saks_fail022', normal, compile_fail, [''])
+test('saks_fail023', normal, compile_fail, [''])
+test('saks_fail024', normal, compile_fail, [''])
+test('saks_fail025', normal, compile_fail, [''])
+test('T16722', normal, compile_fail, [''])
+test('T16727a', normal, compile_fail, [''])
+test('T16727b', normal, compile_fail, [''])
+test('T16725', normal, compile_fail, [''])
+test('T16826', normal, compile_fail, [''])
+test('T16756b', normal, compile_fail, [''])
diff --git a/testsuite/tests/saks/should_fail/saks007_fail.hs b/testsuite/tests/saks/should_fail/saks007_fail.hs
new file mode 100644
index 0000000000..701ffcc17f
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks007_fail.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, GADTs, PolyKinds, DataKinds, ExplicitForAll #-}
+
+-- See also: saks007.hs
+module SAKS_007_fail where
+
+import GHC.TypeLits (Nat)
+import Data.Kind (Type, Constraint)
+
+type family F a where { F Type = True; F _ = False }
+type family G a where { G Type = False; G _ = True }
+
+type X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type
+data X a b where
+ MkX :: X Integer String -- FAIL: F Type ~ G Type
+ -- True ~ False
diff --git a/testsuite/tests/saks/should_fail/saks007_fail.stderr b/testsuite/tests/saks/should_fail/saks007_fail.stderr
new file mode 100644
index 0000000000..ab15984030
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks007_fail.stderr
@@ -0,0 +1,8 @@
+
+saks007_fail.hs:15:10: error:
+ • Couldn't match kind ‘'True’ with ‘'False’
+ Expected kind: G *
+ Actual kind: F *
+ • In the type ‘X Integer String’
+ In the definition of data constructor ‘MkX’
+ In the data declaration for ‘X’
diff --git a/testsuite/tests/saks/should_fail/saks_fail001.hs b/testsuite/tests/saks/should_fail/saks_fail001.hs
new file mode 100644
index 0000000000..c71f7a4a68
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail001.hs
@@ -0,0 +1,8 @@
+-- No -XStandaloneKindSignatures!
+
+module SAKS_Fail001 where
+
+import Data.Kind (Type)
+
+type T :: Type
+data T
diff --git a/testsuite/tests/saks/should_fail/saks_fail001.stderr b/testsuite/tests/saks/should_fail/saks_fail001.stderr
new file mode 100644
index 0000000000..81ab28278d
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail001.stderr
@@ -0,0 +1,4 @@
+
+saks_fail001.hs:7:1: error:
+ Illegal standalone kind signature
+ Did you mean to enable StandaloneKindSignatures?
diff --git a/testsuite/tests/saks/should_fail/saks_fail002.hs b/testsuite/tests/saks/should_fail/saks_fail002.hs
new file mode 100644
index 0000000000..8f37e99ead
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail002.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail002 where
+
+import Data.Kind (Type)
+
+data D
+
+type D :: Type
+type D :: Type
+type D :: Type
diff --git a/testsuite/tests/saks/should_fail/saks_fail002.stderr b/testsuite/tests/saks/should_fail/saks_fail002.stderr
new file mode 100644
index 0000000000..bac0492f3a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail002.stderr
@@ -0,0 +1,6 @@
+
+saks_fail002.hs:9:1: error:
+ Duplicate standalone kind signatures for ‘D’:
+ type D :: Type -- written at saks_fail002.hs:9:1-14
+ type D :: Type -- written at saks_fail002.hs:10:1-14
+ type D :: Type -- written at saks_fail002.hs:11:1-14
diff --git a/testsuite/tests/saks/should_fail/saks_fail003.hs b/testsuite/tests/saks/should_fail/saks_fail003.hs
new file mode 100644
index 0000000000..a1bf05e005
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail003.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+
+module SAKS_Fail003 where
+
+type T :: _
+data T = MkT
diff --git a/testsuite/tests/saks/should_fail/saks_fail003.stderr b/testsuite/tests/saks/should_fail/saks_fail003.stderr
new file mode 100644
index 0000000000..f8f7f7af0d
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail003.stderr
@@ -0,0 +1,4 @@
+
+saks_fail003.hs:6:11: error:
+ Wildcard ‘_’ not allowed
+ in the standalone kind signature for T
diff --git a/testsuite/tests/saks/should_fail/saks_fail004.hs b/testsuite/tests/saks/should_fail/saks_fail004.hs
new file mode 100644
index 0000000000..d5d6b1558a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail004.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, DataKinds #-}
+
+module SAKS_Fail004 where
+
+import Data.Kind (Type)
+
+-- See also: T16263
+type Q :: Eq a => Type
+data Q
diff --git a/testsuite/tests/saks/should_fail/saks_fail004.stderr b/testsuite/tests/saks/should_fail/saks_fail004.stderr
new file mode 100644
index 0000000000..15ec978340
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail004.stderr
@@ -0,0 +1,4 @@
+
+saks_fail004.hs:9:11: error:
+ • Illegal constraint in a kind: forall a. Eq a => *
+ • In a standalone kind signature for ‘Q’: Eq a => Type
diff --git a/testsuite/tests/saks/should_fail/saks_fail005.hs b/testsuite/tests/saks/should_fail/saks_fail005.hs
new file mode 100644
index 0000000000..e930920a0a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail005.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs, PolyKinds #-}
+
+module SAKS_Fail005 where
+
+import Data.Kind (Type)
+import Data.Proxy (Proxy)
+
+-- GADT constructors do not run under bindTyClTyVars,
+-- and thus have no access to scoped type variables.
+type G :: forall k. k -> Type
+data G a where
+ MkG :: forall a. Proxy (a :: k) -> G a
diff --git a/testsuite/tests/saks/should_fail/saks_fail005.stderr b/testsuite/tests/saks/should_fail/saks_fail005.stderr
new file mode 100644
index 0000000000..c0230a9fef
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail005.stderr
@@ -0,0 +1,2 @@
+
+saks_fail005.hs:14:32: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail006.hs b/testsuite/tests/saks/should_fail/saks_fail006.hs
new file mode 100644
index 0000000000..fc9bc51cf3
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail006.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications, PolyKinds #-}
+
+module SAKS_Fail006 where
+
+import Data.Kind (Type)
+
+-- Type family equations do not run under bindTyClTyVars,
+-- and thus have no access to scoped type variables.
+type F :: forall k. k -> k
+type family F a where
+ F (Maybe a) = F @k a
+ F x = x
diff --git a/testsuite/tests/saks/should_fail/saks_fail006.stderr b/testsuite/tests/saks/should_fail/saks_fail006.stderr
new file mode 100644
index 0000000000..fb7cbe18a7
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail006.stderr
@@ -0,0 +1,2 @@
+
+saks_fail006.hs:13:20: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail007.hs b/testsuite/tests/saks/should_fail/saks_fail007.hs
new file mode 100644
index 0000000000..0baeda837b
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail007.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail007 where
+
+import Data.Kind (Type)
+
+type May a :: Type
+data May a = Nay | Yay a
diff --git a/testsuite/tests/saks/should_fail/saks_fail007.stderr b/testsuite/tests/saks/should_fail/saks_fail007.stderr
new file mode 100644
index 0000000000..bc2764b1e7
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail007.stderr
@@ -0,0 +1,2 @@
+
+saks_fail007.hs:7:12: error: parse error on input ‘::’
diff --git a/testsuite/tests/saks/should_fail/saks_fail008.hs b/testsuite/tests/saks/should_fail/saks_fail008.hs
new file mode 100644
index 0000000000..4083e4bfcb
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail008.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE KindSignatures #-}
+
+module SAKS_Fail008 where
+
+import Data.Kind (Type)
+
+type T :: Type -> (Type -> Type) -> Type
+data T a (b :: Type -> Type) x1 (x2 :: Type -> Type)
diff --git a/testsuite/tests/saks/should_fail/saks_fail008.stderr b/testsuite/tests/saks/should_fail/saks_fail008.stderr
new file mode 100644
index 0000000000..4679afb564
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail008.stderr
@@ -0,0 +1,5 @@
+
+saks_fail008.hs:9:1: error:
+ • Not a function kind: *
+ but extra binders found: x1 (x2 :: Type -> Type)
+ • In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail009.hs b/testsuite/tests/saks/should_fail/saks_fail009.hs
new file mode 100644
index 0000000000..317c0e7644
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail009.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_Fail009 where
+
+import Data.Kind (Type)
+
+type T :: forall k -> k -> Type
+data T (k :: Type -> Type) (a :: k)
diff --git a/testsuite/tests/saks/should_fail/saks_fail009.stderr b/testsuite/tests/saks/should_fail/saks_fail009.stderr
new file mode 100644
index 0000000000..8ce43f6d5d
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail009.stderr
@@ -0,0 +1,4 @@
+
+saks_fail009.hs:9:1: error:
+ • Expected kind ‘* -> *’, but ‘k’ has kind ‘*’
+ • In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail010.hs b/testsuite/tests/saks/should_fail/saks_fail010.hs
new file mode 100644
index 0000000000..a427515a82
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail010.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail010 where
+
+import Data.Kind (Type)
+
+type T :: Type -> Type
+data T = MkT Int
diff --git a/testsuite/tests/saks/should_fail/saks_fail010.stderr b/testsuite/tests/saks/should_fail/saks_fail010.stderr
new file mode 100644
index 0000000000..b270ff2e67
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail010.stderr
@@ -0,0 +1,4 @@
+
+saks_fail010.hs:8:1: error:
+ • Expected a type, but found something with kind ‘* -> *’
+ • In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail011.hs b/testsuite/tests/saks/should_fail/saks_fail011.hs
new file mode 100644
index 0000000000..b5c6a11026
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail011.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE GADTs #-}
+
+module SAKS_Fail011 where
+
+import Data.Kind (Type)
+
+type G :: Type -> Type
+data G where
+ MkG :: a -> G a
diff --git a/testsuite/tests/saks/should_fail/saks_fail011.stderr b/testsuite/tests/saks/should_fail/saks_fail011.stderr
new file mode 100644
index 0000000000..ff23c7b1a3
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail011.stderr
@@ -0,0 +1,4 @@
+
+saks_fail011.hs:9:1: error:
+ • Expected a type, but found something with kind ‘* -> *’
+ • In the data type declaration for ‘G’
diff --git a/testsuite/tests/saks/should_fail/saks_fail012.hs b/testsuite/tests/saks/should_fail/saks_fail012.hs
new file mode 100644
index 0000000000..892eb8c418
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail012.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail012 where
+
+import Data.Kind (Type, Constraint)
+
+type C :: Type -> Type -> Constraint
+class C a where
diff --git a/testsuite/tests/saks/should_fail/saks_fail012.stderr b/testsuite/tests/saks/should_fail/saks_fail012.stderr
new file mode 100644
index 0000000000..d43a0ac028
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail012.stderr
@@ -0,0 +1,5 @@
+
+saks_fail012.hs:8:1: error:
+ • Couldn't match expected kind ‘Constraint’
+ with actual kind ‘* -> Constraint’
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/saks/should_fail/saks_fail013.hs b/testsuite/tests/saks/should_fail/saks_fail013.hs
new file mode 100644
index 0000000000..111b521b8a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail013.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+
+module SAKS_Fail013 where
+
+import Data.Kind (Type)
+
+type T :: forall (k :: Type) -> Type
+data T j = MkT (j -> k)
diff --git a/testsuite/tests/saks/should_fail/saks_fail013.stderr b/testsuite/tests/saks/should_fail/saks_fail013.stderr
new file mode 100644
index 0000000000..4e041ba756
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail013.stderr
@@ -0,0 +1,2 @@
+
+saks_fail013.hs:10:22: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail014.hs b/testsuite/tests/saks/should_fail/saks_fail014.hs
new file mode 100644
index 0000000000..e68f448f73
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail014.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies, PolyKinds, ExplicitForAll #-}
+
+module SAKS_Fail014 where
+
+import Data.Kind (Type)
+
+type T :: forall k. k
+type family T :: forall j. j where
+ T = Maybe
+ T = Integer
diff --git a/testsuite/tests/saks/should_fail/saks_fail014.stderr b/testsuite/tests/saks/should_fail/saks_fail014.stderr
new file mode 100644
index 0000000000..68733410ee
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail014.stderr
@@ -0,0 +1,11 @@
+
+saks_fail014.hs:10:7: error:
+ • Expecting one more argument to ‘Maybe’
+ Expected kind ‘forall k. k’, but ‘Maybe’ has kind ‘* -> *’
+ • In the type ‘Maybe’
+ In the type family declaration for ‘T’
+
+saks_fail014.hs:11:7: error:
+ • Expected kind ‘forall k. k’, but ‘Integer’ has kind ‘*’
+ • In the type ‘Integer’
+ In the type family declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail015.hs b/testsuite/tests/saks/should_fail/saks_fail015.hs
new file mode 100644
index 0000000000..78ee15e314
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail015.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+
+module SAKS_Fail015 where
+
+import Data.Kind (Type)
+import Data.Proxy (Proxy)
+
+type T :: forall k. k -> Type
+data T a = MkT (Proxy (a :: k)) -- 'k' is not brought into scope by ScopedTypeVariables
diff --git a/testsuite/tests/saks/should_fail/saks_fail015.stderr b/testsuite/tests/saks/should_fail/saks_fail015.stderr
new file mode 100644
index 0000000000..d85b1a4c22
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail015.stderr
@@ -0,0 +1,2 @@
+
+saks_fail015.hs:11:29: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail016.hs b/testsuite/tests/saks/should_fail/saks_fail016.hs
new file mode 100644
index 0000000000..f2966876ba
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail016.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds, ConstraintKinds, ExplicitForAll #-}
+
+module SAKS_Fail016 where
+
+import Data.Kind (Constraint)
+
+data T (a :: k)
+
+type C :: forall k. k -> Constraint
+class C a where
+ getC :: forall. T (a :: k) -- 'k' is not brought into scope by ScopedTypeVariables
diff --git a/testsuite/tests/saks/should_fail/saks_fail016.stderr b/testsuite/tests/saks/should_fail/saks_fail016.stderr
new file mode 100644
index 0000000000..8f501674ea
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail016.stderr
@@ -0,0 +1,2 @@
+
+saks_fail016.hs:13:27: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail017.hs b/testsuite/tests/saks/should_fail/saks_fail017.hs
new file mode 100644
index 0000000000..b13f27c7f9
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail017.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds, TypeApplications #-}
+
+module SAKS_Fail017 where
+
+import Data.Kind (Type)
+
+data T (a :: k)
+
+type S :: forall k. k -> Type
+type S = T @k -- 'k' is not brought into scope by ScopedTypeVariables
diff --git a/testsuite/tests/saks/should_fail/saks_fail017.stderr b/testsuite/tests/saks/should_fail/saks_fail017.stderr
new file mode 100644
index 0000000000..b43ff35632
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail017.stderr
@@ -0,0 +1,2 @@
+
+saks_fail017.hs:12:13: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail018.hs b/testsuite/tests/saks/should_fail/saks_fail018.hs
new file mode 100644
index 0000000000..4febbe2530
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail018.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_Fail018 where
+
+import Data.Kind (Type)
+
+data P w
+
+-- j = k, x = a
+type T :: forall k. forall (a :: k) -> Type
+data T (x :: j) = MkT (P k) (P j) (P x) -- 'k' is not brought into scope by ScopedTypeVariables
diff --git a/testsuite/tests/saks/should_fail/saks_fail018.stderr b/testsuite/tests/saks/should_fail/saks_fail018.stderr
new file mode 100644
index 0000000000..38b7c59662
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail018.stderr
@@ -0,0 +1,2 @@
+
+saks_fail018.hs:13:26: error: Not in scope: type variable ‘k’
diff --git a/testsuite/tests/saks/should_fail/saks_fail019.hs b/testsuite/tests/saks/should_fail/saks_fail019.hs
new file mode 100644
index 0000000000..51cdd54ca2
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail019.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds, ExplicitForAll #-}
+
+module SAKS_Fail019 where
+
+import Data.Kind (Type)
+
+type T :: Type -> Type -> Type
+data T a :: a -> Type
+ -- Should not panic with:
+ -- GHC internal error: ‘a’ is not in scope during type checking, but it passed the renamer
diff --git a/testsuite/tests/saks/should_fail/saks_fail019.stderr b/testsuite/tests/saks/should_fail/saks_fail019.stderr
new file mode 100644
index 0000000000..5bdb26a933
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail019.stderr
@@ -0,0 +1,6 @@
+
+saks_fail019.hs:9:1: error:
+ • Couldn't match kind ‘a’ with ‘*’
+ Expected kind: a -> *
+ Actual kind: * -> *
+ • In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail020.hs b/testsuite/tests/saks/should_fail/saks_fail020.hs
new file mode 100644
index 0000000000..69812aea8b
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail020.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}
+
+module SAKS_Fail020 where
+
+import Data.Kind
+import Data.Proxy
+
+type Foo2 :: () -> forall (k :: Type) -> Proxy (a :: k)
+type family Foo2 d k where {}
+
diff --git a/testsuite/tests/saks/should_fail/saks_fail020.stderr b/testsuite/tests/saks/should_fail/saks_fail020.stderr
new file mode 100644
index 0000000000..7f4f33f631
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail020.stderr
@@ -0,0 +1,6 @@
+
+saks_fail020.hs:9:49: error:
+ • Expected kind ‘k’, but ‘a’ has kind ‘k0’
+ • In the first argument of ‘Proxy’, namely ‘(a :: k)’
+ In a standalone kind signature for ‘Foo2’:
+ () -> forall (k :: Type) -> Proxy (a :: k)
diff --git a/testsuite/tests/saks/should_fail/saks_fail021.hs b/testsuite/tests/saks/should_fail/saks_fail021.hs
new file mode 100644
index 0000000000..a702ea0a6a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail021.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}
+
+module SAKS_Fail021 where
+
+import Data.Kind
+import Data.Proxy
+
+type C :: Type -> Constraint
+class C (a :: k) where
+ type F k
diff --git a/testsuite/tests/saks/should_fail/saks_fail021.stderr b/testsuite/tests/saks/should_fail/saks_fail021.stderr
new file mode 100644
index 0000000000..6128aff165
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail021.stderr
@@ -0,0 +1,4 @@
+
+saks_fail021.hs:10:1: error:
+ • Expected kind ‘k’, but ‘a’ has kind ‘*’
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/saks/should_fail/saks_fail022.hs b/testsuite/tests/saks/should_fail/saks_fail022.hs
new file mode 100644
index 0000000000..47638f84b5
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail022.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}
+
+module SAKS_Fail022 where
+
+import Data.Kind
+import Data.Proxy
+
+type C :: (x,y) -> Constraint
+class C (a :: k) where
+ type F k
diff --git a/testsuite/tests/saks/should_fail/saks_fail022.stderr b/testsuite/tests/saks/should_fail/saks_fail022.stderr
new file mode 100644
index 0000000000..e0cc222344
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail022.stderr
@@ -0,0 +1,4 @@
+
+saks_fail022.hs:10:1: error:
+ • Expected kind ‘k’, but ‘a’ has kind ‘(x, y)’
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/saks/should_fail/saks_fail023.hs b/testsuite/tests/saks/should_fail/saks_fail023.hs
new file mode 100644
index 0000000000..371f7ac925
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail023.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}
+
+module SAKS_Fail023 where
+
+import Data.Kind
+import Data.Proxy
+
+type C :: Type -> Constraint
+class C (a :: k) where
+ type F :: k -> k
diff --git a/testsuite/tests/saks/should_fail/saks_fail023.stderr b/testsuite/tests/saks/should_fail/saks_fail023.stderr
new file mode 100644
index 0000000000..3af24c7abb
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail023.stderr
@@ -0,0 +1,4 @@
+
+saks_fail023.hs:10:1: error:
+ • Expected kind ‘k’, but ‘a’ has kind ‘*’
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/saks/should_fail/saks_fail024.hs b/testsuite/tests/saks/should_fail/saks_fail024.hs
new file mode 100644
index 0000000000..714b19c4b6
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail024.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail024 where
+
+import Data.Kind (Type)
+
+type Data.Kind.Type :: Type
diff --git a/testsuite/tests/saks/should_fail/saks_fail024.stderr b/testsuite/tests/saks/should_fail/saks_fail024.stderr
new file mode 100644
index 0000000000..0266358356
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail024.stderr
@@ -0,0 +1,3 @@
+
+saks_fail024.hs:7:6: error:
+ Expected an unqualified type constructor: Data.Kind.Type
diff --git a/testsuite/tests/saks/should_fail/saks_fail025.hs b/testsuite/tests/saks/should_fail/saks_fail025.hs
new file mode 100644
index 0000000000..01c0af016a
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail025.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module SAKS_Fail024 where
+
+import Data.Kind (Type)
+
+type A, B, C :: Type
+
+data A
+data B
+data C
diff --git a/testsuite/tests/saks/should_fail/saks_fail025.stderr b/testsuite/tests/saks/should_fail/saks_fail025.stderr
new file mode 100644
index 0000000000..52e1527d3b
--- /dev/null
+++ b/testsuite/tests/saks/should_fail/saks_fail025.stderr
@@ -0,0 +1,5 @@
+
+saks_fail025.hs:7:6: error:
+ Standalone kind signatures do not support multiple names at the moment:
+ A, B, C
+ See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details.
diff --git a/testsuite/tests/typecheck/should_fail/T12035.stderr b/testsuite/tests/typecheck/should_fail/T12035.stderr
index c6113ea207..375b94c95a 100644
--- a/testsuite/tests/typecheck/should_fail/T12035.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12035.stderr
@@ -2,5 +2,7 @@
T12035.hs-boot:2:1: error:
Type constructor ‘T’ has conflicting definitions in the module
and its hs-boot file
- Main module: type T = Bool
- Boot file: data T
+ Main module: type T :: *
+ type T = Bool
+ Boot file: type T :: *
+ data T
diff --git a/testsuite/tests/typecheck/should_fail/T12035j.stderr b/testsuite/tests/typecheck/should_fail/T12035j.stderr
index c6113ea207..375b94c95a 100644
--- a/testsuite/tests/typecheck/should_fail/T12035j.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12035j.stderr
@@ -2,5 +2,7 @@
T12035.hs-boot:2:1: error:
Type constructor ‘T’ has conflicting definitions in the module
and its hs-boot file
- Main module: type T = Bool
- Boot file: data T
+ Main module: type T :: *
+ type T = Bool
+ Boot file: type T :: *
+ data T
diff --git a/testsuite/tests/typecheck/should_fail/T12042.stderr b/testsuite/tests/typecheck/should_fail/T12042.stderr
index 3266a1fe11..ae3cf33ea7 100644
--- a/testsuite/tests/typecheck/should_fail/T12042.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12042.stderr
@@ -5,5 +5,7 @@
T12042.hs-boot:2:1: error:
Type constructor ‘S’ has conflicting definitions in the module
and its hs-boot file
- Main module: type S = R
- Boot file: data S
+ Main module: type S :: *
+ type S = R
+ Boot file: type S :: *
+ data S
diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr
index 0a0fec223b..c8aa7622f8 100644
--- a/testsuite/tests/typecheck/should_fail/T3468.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3468.stderr
@@ -3,6 +3,8 @@ T3468.hs-boot:3:1: error:
Type constructor ‘Tool’ has conflicting definitions in the module
and its hs-boot file
Main module: type role Tool phantom
+ type Tool :: * -> *
data Tool d = forall a r. F a
- Boot file: data Tool
+ Boot file: type Tool :: *
+ data Tool
The types have different kinds
diff --git a/testsuite/tests/typecheck/should_fail/T9201.stderr b/testsuite/tests/typecheck/should_fail/T9201.stderr
index 28f2f1d391..5e8f0173c5 100644
--- a/testsuite/tests/typecheck/should_fail/T9201.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9201.stderr
@@ -3,5 +3,4 @@ T9201.hs:6:17: error:
• Expected kind ‘x’, but ‘a’ has kind ‘y’
• In the first argument of ‘f’, namely ‘a’
In the second argument of ‘d’, namely ‘(f a)’
- In the type signature:
- ret :: d a (f a)
+ In the type signature: ret :: d a (f a)
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
index 13c9836c43..c868a1321e 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
@@ -1,4 +1,5 @@
-UnliftedNewtypesFamilyKindFail1.hs:11:31:
- Expected a type, but ‘5’ has kind ‘GHC.Types.Nat’
- In the kind ‘5’
+
+UnliftedNewtypesFamilyKindFail1.hs:11:31: error:
+ • Expected a type, but ‘5’ has kind ‘GHC.Types.Nat’
+ • In the kind ‘5’
In the data family declaration for ‘DF’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail210.stderr b/testsuite/tests/typecheck/should_fail/tcfail210.stderr
index 9df9b7ef8f..819a9524fb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail210.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail210.stderr
@@ -1,3 +1,3 @@
-tcfail210.hs:4:31:
+tcfail210.hs:4:31: error:
Not in scope: type constructor or class ‘Constraint’