diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-10-05 17:42:15 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-11-22 02:06:52 -0500 |
| commit | e5b68183700f159c834936be3a9b08f165fdc5e3 (patch) | |
| tree | d22ad0710b3b062d082c552a165b998b55e30b66 | |
| parent | 7181b0742fec878137b1fcb7c3a86c4a95e3da47 (diff) | |
| download | haskell-e5b68183700f159c834936be3a9b08f165fdc5e3.tar.gz | |
Optimize getLevity.
Avoid the intermediate data structures allocated by splitTyConApp.
This avoids ~0.5% of allocations for a build using -O2.
Fixes #22254
| -rw-r--r-- | compiler/GHC/Core/Type.hs | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 7e0444cbfe..70a707b17b 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -260,7 +260,7 @@ import GHC.Builtin.Types.Prim import {-# SOURCE #-} GHC.Builtin.Types ( charTy, naturalTy , typeSymbolKind, liftedTypeKind, unliftedTypeKind - , boxedRepDataConTyCon, constraintKind, zeroBitTypeKind + , constraintKind, zeroBitTypeKind , manyDataConTy, oneDataConTy , liftedRepTy, unliftedRepTy, zeroBitRepTy ) @@ -596,6 +596,8 @@ interfaces. Notably this plays a role in tcTySigs in GHC.Tc.Gen.Bind. -- -- @isTyConKeyApp_maybe key ty@ returns @Just tys@ iff -- the type @ty = T tys@, where T's unique = key +-- key must not be `fUNTyConKey`; to test for functions, use `splitFunTy_maybe`. +-- Thanks to this fact, we don't have to pattern match on `FunTy` here. isTyConKeyApp_maybe :: Unique -> Type -> Maybe [Type] isTyConKeyApp_maybe key ty | TyConApp tc args <- coreFullView ty @@ -2313,8 +2315,11 @@ getRuntimeRep ty getLevity_maybe :: HasDebugCallStack => Type -> Maybe Type getLevity_maybe ty | Just rep <- getRuntimeRep_maybe ty - , Just (tc, [lev]) <- splitTyConApp_maybe rep - , tc == boxedRepDataConTyCon + -- Directly matching on TyConApp after expanding type synonyms + -- saves allocations compared to `splitTyConApp_maybe`. See #22254. + -- Given that this is a pretty hot function we make use of the fact + -- and use isTyConKeyApp_maybe instead. + , Just [lev] <- isTyConKeyApp_maybe boxedRepDataConKey rep = Just lev | otherwise = Nothing |