diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-10-05 17:42:15 +0200 |
|---|---|---|
| committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-11-21 14:56:42 +0100 |
| commit | 358fb9b01b8b0aec1442131a80992f213df55455 (patch) | |
| tree | 23862a87c2631a862ccfeda947fa1b0cd0cf14ae | |
| parent | 451aeac3b07f171f148995717d0d9a1eefe08f0e (diff) | |
| download | haskell-wip/andreask/opt-getlevity.tar.gz | |
Optimize getLevity.wip/andreask/opt-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 |