summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-12-22 07:02:06 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-02 12:24:11 -0500
commit7d910fd812c7c29f59fac7f1991b3b057460a058 (patch)
tree13f74142ddc6f8c81de16396d4c0b9c8bd5c2298
parentc0709c1d1dcb60a238e9fc59ac33124e2a0c415d (diff)
downloadhaskell-7d910fd812c7c29f59fac7f1991b3b057460a058.tar.gz
typecheck: Eliminate allocations in tc_eq_type
Previously tc_eq_type would allocate a number of closures due to the two boolean "mode" flags, despite the fact that these were always statically known. To avoid this we force tc_eq_type to inline into its call sites, allowing the simplifier to eliminate both some runtime branches and the closure allocations.
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs49
1 files changed, 36 insertions, 13 deletions
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 8b85ff1a6c..6f009e9065 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -1521,8 +1521,8 @@ tcEqType :: HasDebugCallStack => TcType -> TcType -> Bool
-- ^ tcEqType implements typechecker equality, as described in
-- @Note [Typechecker equality vs definitional equality]@.
tcEqType ty1 ty2
- = tc_eq_type False False ki1 ki2
- && tc_eq_type False False ty1 ty2
+ = tcEqTypeNoSyns ki1 ki2
+ && tcEqTypeNoSyns ty1 ty2
where
ki1 = tcTypeKind ty1
ki2 = tcTypeKind ty2
@@ -1531,7 +1531,39 @@ tcEqType ty1 ty2
-- as long as their non-coercion structure is identical.
tcEqTypeNoKindCheck :: TcType -> TcType -> Bool
tcEqTypeNoKindCheck ty1 ty2
- = tc_eq_type False False ty1 ty2
+ = tcEqTypeNoSyns ty1 ty2
+
+-- | Check whether two TyConApps are the same; if the number of arguments
+-- are different, just checks the common prefix of arguments.
+tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool
+tcEqTyConApps tc1 args1 tc2 args2
+ = tc1 == tc2 &&
+ and (zipWith tcEqTypeNoKindCheck args1 args2)
+ -- No kind check necessary: if both arguments are well typed, then
+ -- any difference in the kinds of later arguments would show up
+ -- as differences in earlier (dependent) arguments
+
+{-
+Note [Specialising tc_eq_type]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The type equality predicates in TcType are hit pretty hard during typechecking.
+Consequently we take pains to ensure that these paths are compiled to
+efficient, minimally-allocating code.
+
+To this end we place an INLINE on tc_eq_type, ensuring that it is inlined into
+its publicly-visible interfaces (e.g. tcEqType). In addition to eliminating
+some dynamic branches, this allows the simplifier to eliminate the closure
+allocations that would otherwise be necessary to capture the two boolean "mode"
+flags. This reduces allocations by a good fraction of a percent when compiling
+Cabal.
+
+See #19226.
+-}
+
+-- | Type equality comparing both visible and invisible arguments and expanding
+-- type synonyms.
+tcEqTypeNoSyns :: TcType -> TcType -> Bool
+tcEqTypeNoSyns ta tb = tc_eq_type False False ta tb
-- | Like 'tcEqType', but returns True if the /visible/ part of the types
-- are equal, even if they are really unequal (in the invisible bits)
@@ -1545,16 +1577,6 @@ pickyEqType :: TcType -> TcType -> Bool
-- This ignores kinds and coercions, because this is used only for printing.
pickyEqType ty1 ty2 = tc_eq_type True False ty1 ty2
--- | Check whether two TyConApps are the same; if the number of arguments
--- are different, just checks the common prefix of arguments.
-tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool
-tcEqTyConApps tc1 args1 tc2 args2
- = tc1 == tc2 &&
- and (zipWith tcEqTypeNoKindCheck args1 args2)
- -- No kind check necessary: if both arguments are well typed, then
- -- any difference in the kinds of later arguments would show up
- -- as differences in earlier (dependent) arguments
-
-- | Real worker for 'tcEqType'. No kind check!
tc_eq_type :: Bool -- ^ True <=> do not expand type synonyms
-> Bool -- ^ True <=> compare visible args only
@@ -1647,6 +1669,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
= go env w w' && go env arg arg' && go env res res'
get_args _ _ = False
eqFunTy _ _ _ _ _ = False
+{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type].
{- Note [Typechecker equality vs definitional equality]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~