[Git][ghc/ghc][master] Stricter Binary.get in GHC.Types.Unit (#23964)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Oct 10 23:03:20 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1f11e7c4 by Sebastian Graf at 2023-10-10T19:01:58-04:00
Stricter Binary.get in GHC.Types.Unit (#23964)
I noticed some thunking while looking at Core.
This change has very modest, but throughout positive ghc/alloc effect:
```
hard_hole_fits(normal) ghc/alloc 283,057,664 281,620,872 -0.5%
geo. mean -0.1%
minimum -0.5%
maximum +0.0%
```
Fixes #23964.
- - - - -
1 changed file:
- compiler/GHC/Unit/Types.hs
Changes:
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -149,7 +149,8 @@ instance Uniquable Module where
instance Binary a => Binary (GenModule a) where
put_ bh (Module p n) = put_ bh p >> put_ bh n
- get bh = do p <- get bh; n <- get bh; return (Module p n)
+ -- Module has strict fields, so use $! in order not to allocate a thunk
+ get bh = do p <- get bh; n <- get bh; return $! Module p n
instance NFData (GenModule a) where
rnf (Module unit name) = unit `seq` name `seq` ()
@@ -317,13 +318,14 @@ instance Binary InstantiatedUnit where
cid <- get bh
insts <- get bh
let fs = mkInstantiatedUnitHash cid insts
- return InstantiatedUnit {
- instUnitInstanceOf = cid,
- instUnitInsts = insts,
- instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
- instUnitFS = fs,
- instUnitKey = getUnique fs
- }
+ -- InstantiatedUnit has strict fields, so use $! in order not to allocate a thunk
+ return $! InstantiatedUnit {
+ instUnitInstanceOf = cid,
+ instUnitInsts = insts,
+ instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
+ instUnitFS = fs,
+ instUnitKey = getUnique fs
+ }
instance IsUnitId u => Eq (GenUnit u) where
uid1 == uid2 = unitUnique uid1 == unitUnique uid2
@@ -369,10 +371,12 @@ instance Binary Unit where
put_ bh HoleUnit =
putByte bh 2
get bh = do b <- getByte bh
- case b of
+ u <- case b of
0 -> fmap RealUnit (get bh)
1 -> fmap VirtUnit (get bh)
_ -> pure HoleUnit
+ -- Unit has strict fields that need forcing; otherwise we allocate a thunk.
+ pure $! u
-- | Retrieve the set of free module holes of a 'Unit'.
unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f11e7c44e2fa60ce92bd1406e8aea66e3fa29cf
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f11e7c44e2fa60ce92bd1406e8aea66e3fa29cf
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/20231010/96389f3b/attachment-0001.html>
More information about the ghc-commits
mailing list