summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2020-04-08 17:26:55 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-09 23:11:21 -0400
commit101fab6ee6cee72b9ffce40e45ebf39466d1c01a (patch)
treec122df48ecbc2e1db472e43d2b6fac5be7b9a9d4
parent045139f40089f288866c1c59c7379be82ecdaf34 (diff)
downloadhaskell-101fab6ee6cee72b9ffce40e45ebf39466d1c01a.tar.gz
Special case `isConstraintKindCon` on `AlgTyCon`
Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234
-rw-r--r--compiler/GHC/Core/TyCon.hs11
-rw-r--r--compiler/GHC/Core/Type.hs3
-rw-r--r--compiler/prelude/TysWiredIn.hs1
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