diff options
| -rw-r--r-- | compiler/GHC/Core/TyCon.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Core/Type.hs | 3 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 1 |
3 files changed, 11 insertions, 4 deletions
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index 64782e02b4..d28d8b0f0c 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -45,7 +45,7 @@ module GHC.Core.TyCon( noTcTyConScopedTyVars, -- ** Predicates on TyCons - isAlgTyCon, isVanillaAlgTyCon, + isAlgTyCon, isVanillaAlgTyCon, isConstraintKindCon, isClassTyCon, isFamInstTyCon, isFunTyCon, isPrimTyCon, @@ -1868,6 +1868,15 @@ isVanillaAlgTyCon :: TyCon -> Bool isVanillaAlgTyCon (AlgTyCon { algTcParent = VanillaAlgTyCon _ }) = True isVanillaAlgTyCon _ = False +-- | Returns @True@ for the 'TyCon' of the 'Constraint' kind. +isConstraintKindCon :: TyCon -> Bool +-- NB: We intentionally match on AlgTyCon, because 'constraintKindTyCon' is +-- always an AlgTyCon (see 'pcTyCon' in TysWiredIn) and the record selector +-- for 'tyConUnique' would generate unreachable code for every other data +-- constructor of TyCon (see #18026). +isConstraintKindCon AlgTyCon { tyConUnique = u } = u == constraintKindTyConKey +isConstraintKindCon _ = False + isDataTyCon :: TyCon -> Bool -- ^ Returns @True@ for data types that are /definitely/ represented by -- heap-allocated constructors. These are scrutinised by Core-level diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 7e7a72fe94..a218e7c7b5 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -2924,9 +2924,6 @@ distinct uniques, they are treated as equal at all times except during type inference. -} -isConstraintKindCon :: TyCon -> Bool -isConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey - -- | Tests whether the given kind (which should look like @TYPE x@) -- is something other than a constructor tree (that is, constructors at every node). -- E.g. True of TYPE k, TYPE (F Int) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 4bf7ad6642..682c9d7d8a 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -639,6 +639,7 @@ typeNatKind = mkTyConTy typeNatKindCon typeSymbolKind = mkTyConTy typeSymbolKindCon constraintKindTyCon :: TyCon +-- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind |