[Git][ghc/ghc][master] Pack some of IdInfo fields into a bit field
Marge Bot
gitlab at gitlab.haskell.org
Wed May 13 06:03:27 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00
Pack some of IdInfo fields into a bit field
This reduces residency of compiler quite a bit on some programs.
Example stats when building T10370:
Before:
2,871,242,832 bytes allocated in the heap
4,693,328,008 bytes copied during GC
33,941,448 bytes maximum residency (276 sample(s))
375,976 bytes maximum slop
83 MiB total memory in use (0 MB lost due to fragmentation)
After:
2,858,897,344 bytes allocated in the heap
4,629,255,440 bytes copied during GC
32,616,624 bytes maximum residency (278 sample(s))
314,400 bytes maximum slop
80 MiB total memory in use (0 MB lost due to fragmentation)
So -3.9% residency, -1.3% bytes copied and -0.4% allocations.
Fixes #17497
Metric Decrease:
T9233
T9675
- - - - -
1 changed file:
- compiler/GHC/Types/Id/Info.hs
Changes:
=====================================
compiler/GHC/Types/Id/Info.hs
=====================================
@@ -10,6 +10,7 @@ Haskell. [WDP 94/11])
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE BinaryLiterals #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -105,6 +106,9 @@ import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Utils.Misc
+import Data.Word
+import Data.Bits
+
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setRuleInfo`,
`setArityInfo`,
@@ -242,19 +246,11 @@ pprIdDetails other = brackets (pp other)
-- too big.
data IdInfo
= IdInfo {
- arityInfo :: !ArityInfo,
- -- ^ 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many
- -- arguments this 'Id' has to be applied to before it doesn any
- -- meaningful work.
ruleInfo :: RuleInfo,
-- ^ Specialisations of the 'Id's function which exist.
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding,
-- ^ The 'Id's unfolding
- cafInfo :: CafInfo,
- -- ^ 'Id' CAF info
- oneShotInfo :: OneShotInfo,
- -- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma,
-- ^ Any inline pragma attached to the 'Id'
occInfo :: OccInfo,
@@ -267,14 +263,103 @@ data IdInfo
-- freshly allocated constructor.
demandInfo :: Demand,
-- ^ ID demand information
- callArityInfo :: !ArityInfo,
- -- ^ How this is called. This is the number of arguments to which a
- -- binding can be eta-expanded without losing any sharing.
- -- n <=> all calls have at least n arguments
- levityInfo :: LevityInfo
- -- ^ when applied, will this Id ever have a levity-polymorphic type?
+ bitfield :: {-# UNPACK #-} !BitField
+ -- ^ Bitfield packs CafInfo, OneShotInfo, arity info, LevityInfo, and
+ -- call arity info in one 64-bit word. Packing these fields reduces size
+ -- of `IdInfo` from 12 words to 7 words and reduces residency by almost
+ -- 4% in some programs.
+ --
+ -- See documentation of the getters for what these packed fields mean.
}
+-- | Encodes arities, OneShotInfo, CafInfo and LevityInfo.
+-- From least-significant to most-significant bits:
+--
+-- - Bit 0 (1): OneShotInfo
+-- - Bit 1 (1): CafInfo
+-- - Bit 2 (1): LevityInfo
+-- - Bits 3-32(30): Call Arity info
+-- - Bits 33-62(30): Arity info
+--
+newtype BitField = BitField Word64
+
+emptyBitField :: BitField
+emptyBitField = BitField 0
+
+bitfieldGetOneShotInfo :: BitField -> OneShotInfo
+bitfieldGetOneShotInfo (BitField bits) =
+ if testBit bits 0 then OneShotLam else NoOneShotInfo
+
+bitfieldGetCafInfo :: BitField -> CafInfo
+bitfieldGetCafInfo (BitField bits) =
+ if testBit bits 1 then NoCafRefs else MayHaveCafRefs
+
+bitfieldGetLevityInfo :: BitField -> LevityInfo
+bitfieldGetLevityInfo (BitField bits) =
+ if testBit bits 2 then NeverLevityPolymorphic else NoLevityInfo
+
+bitfieldGetCallArityInfo :: BitField -> ArityInfo
+bitfieldGetCallArityInfo (BitField bits) =
+ fromIntegral (bits `shiftR` 3) .&. ((1 `shiftL` 30) - 1)
+
+bitfieldGetArityInfo :: BitField -> ArityInfo
+bitfieldGetArityInfo (BitField bits) =
+ fromIntegral (bits `shiftR` 33)
+
+bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
+bitfieldSetOneShotInfo info (BitField bits) =
+ case info of
+ NoOneShotInfo -> BitField (clearBit bits 0)
+ OneShotLam -> BitField (setBit bits 0)
+
+bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
+bitfieldSetCafInfo info (BitField bits) =
+ case info of
+ MayHaveCafRefs -> BitField (clearBit bits 1)
+ NoCafRefs -> BitField (setBit bits 1)
+
+bitfieldSetLevityInfo :: LevityInfo -> BitField -> BitField
+bitfieldSetLevityInfo info (BitField bits) =
+ case info of
+ NoLevityInfo -> BitField (clearBit bits 2)
+ NeverLevityPolymorphic -> BitField (setBit bits 2)
+
+bitfieldSetCallArityInfo :: ArityInfo -> BitField -> BitField
+bitfieldSetCallArityInfo info bf@(BitField bits) =
+ ASSERT(info < 2^(30 :: Int) - 1)
+ bitfieldSetArityInfo (bitfieldGetArityInfo bf) $
+ BitField ((fromIntegral info `shiftL` 3) .|. (bits .&. 0b111))
+
+bitfieldSetArityInfo :: ArityInfo -> BitField -> BitField
+bitfieldSetArityInfo info (BitField bits) =
+ ASSERT(info < 2^(30 :: Int) - 1)
+ BitField ((fromIntegral info `shiftL` 33) .|. (bits .&. ((1 `shiftL` 33) - 1)))
+
+-- Getters
+
+-- | When applied, will this Id ever have a levity-polymorphic type?
+levityInfo :: IdInfo -> LevityInfo
+levityInfo = bitfieldGetLevityInfo . bitfield
+
+-- | Info about a lambda-bound variable, if the 'Id' is one
+oneShotInfo :: IdInfo -> OneShotInfo
+oneShotInfo = bitfieldGetOneShotInfo . bitfield
+
+-- | 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many arguments
+-- this 'Id' has to be applied to before it doesn any meaningful work.
+arityInfo :: IdInfo -> ArityInfo
+arityInfo = bitfieldGetArityInfo . bitfield
+
+-- | 'Id' CAF info
+cafInfo :: IdInfo -> CafInfo
+cafInfo = bitfieldGetCafInfo . bitfield
+
+-- | How this is called. This is the number of arguments to which a binding can
+-- be eta-expanded without losing any sharing. n <=> all calls have at least n
+-- arguments
+callArityInfo :: IdInfo -> ArityInfo
+callArityInfo = bitfieldGetCallArityInfo . bitfield
+
-- Setters
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
@@ -294,14 +379,20 @@ setUnfoldingInfo info uf
info { unfoldingInfo = uf }
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
-setArityInfo info ar = info { arityInfo = ar }
+setArityInfo info ar =
+ info { bitfield = bitfieldSetArityInfo ar (bitfield info) }
+
setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
-setCallArityInfo info ar = info { callArityInfo = ar }
+setCallArityInfo info ar =
+ info { bitfield = bitfieldSetCallArityInfo ar (bitfield info) }
+
setCafInfo :: IdInfo -> CafInfo -> IdInfo
-setCafInfo info caf = info { cafInfo = caf }
+setCafInfo info caf =
+ info { bitfield = bitfieldSetCafInfo caf (bitfield info) }
setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
-setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb }
+setOneShotInfo info lb =
+ info { bitfield = bitfieldSetOneShotInfo lb (bitfield info) }
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo info dd = dd `seq` info { demandInfo = dd }
@@ -316,18 +407,19 @@ setCprInfo info cpr = cpr `seq` info { cprInfo = cpr }
vanillaIdInfo :: IdInfo
vanillaIdInfo
= IdInfo {
- cafInfo = vanillaCafInfo,
- arityInfo = unknownArity,
ruleInfo = emptyRuleInfo,
unfoldingInfo = noUnfolding,
- oneShotInfo = NoOneShotInfo,
inlinePragInfo = defaultInlinePragma,
occInfo = noOccInfo,
demandInfo = topDmd,
strictnessInfo = nopSig,
cprInfo = topCprSig,
- callArityInfo = unknownArity,
- levityInfo = NoLevityInfo
+ bitfield = bitfieldSetCafInfo vanillaCafInfo $
+ bitfieldSetArityInfo unknownArity $
+ bitfieldSetCallArityInfo unknownArity $
+ bitfieldSetOneShotInfo NoOneShotInfo $
+ bitfieldSetLevityInfo NoLevityInfo $
+ emptyBitField
}
-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
@@ -638,12 +730,12 @@ instance Outputable LevityInfo where
setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
setNeverLevPoly info ty
= ASSERT2( not (resultIsLevPoly ty), ppr ty )
- info { levityInfo = NeverLevityPolymorphic }
+ info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) }
setLevityInfoWithType :: IdInfo -> Type -> IdInfo
setLevityInfoWithType info ty
| not (resultIsLevPoly ty)
- = info { levityInfo = NeverLevityPolymorphic }
+ = info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) }
| otherwise
= info
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a03da9bfcf130bec616e0f77bbefbf62022753de
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a03da9bfcf130bec616e0f77bbefbf62022753de
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200513/09f17a00/attachment-0001.html>
More information about the ghc-commits
mailing list