[Git][ghc/ghc][wip/unfolding-leaks] 2 commits: core stats: Count the number of binders
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Aug 10 10:25:24 UTC 2022
Matthew Pickering pushed to branch wip/unfolding-leaks at Glasgow Haskell Compiler / GHC
Commits:
5863a12e by Matthew Pickering at 2022-08-10T11:25:14+01:00
core stats: Count the number of binders
Counting the number of binders allows you to place reasonable bounds on
how many IdInfo you expect to be alive in a program.
- - - - -
5353d311 by Matthew Pickering at 2022-08-10T11:25:14+01:00
Force unfoldings when they are cleaned-up in Tidy and CorePrep
If these thunks are not forced then the entire unfolding for the binding
is live throughout the whole of CodeGen despite the fact it should have
been discarded.
- - - - -
3 changed files:
- compiler/GHC/Core/Stats.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Iface/Tidy.hs
Changes:
=====================================
compiler/GHC/Core/Stats.hs
=====================================
@@ -26,26 +26,30 @@ data CoreStats = CS { cs_tm :: !Int -- Terms
, cs_ty :: !Int -- Types
, cs_co :: !Int -- Coercions
, cs_vb :: !Int -- Local value bindings
- , cs_jb :: !Int } -- Local join bindings
+ , cs_jb :: !Int -- Local join bindings
+ , cs_bs :: !Int -- Total binding sites (local and global)
+ }
instance Outputable CoreStats where
- ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 })
+ ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5, cs_bs = i6 })
= braces (sep [text "terms:" <+> intWithCommas i1 <> comma,
text "types:" <+> intWithCommas i2 <> comma,
text "coercions:" <+> intWithCommas i3 <> comma,
text "joins:" <+> intWithCommas i5 <> char '/' <>
- intWithCommas (i4 + i5) ])
+ intWithCommas (i4 + i5) <> comma,
+ text "binders:" <+> intWithCommas i6 ])
plusCS :: CoreStats -> CoreStats -> CoreStats
-plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 })
- (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 })
+plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1, cs_bs = b1 })
+ (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2, cs_bs = b2 })
= CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2
- , cs_jb = j1+j2 }
+ , cs_jb = j1+j2, cs_bs = b1 + b2 }
-zeroCS, oneTM :: CoreStats
-zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }
+zeroCS, oneTM, oneBinder :: CoreStats
+zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0, cs_bs = 0 }
oneTM = zeroCS { cs_tm = 1 }
+oneBinder = zeroCS { cs_bs = 1 }
sumCS :: (a -> CoreStats) -> [a] -> CoreStats
sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS
@@ -61,13 +65,13 @@ bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats
bindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r
bndrStats :: Var -> CoreStats
-bndrStats v = oneTM `plusCS` tyStats (varType v)
+bndrStats v = oneTM `plusCS` tyStats (varType v) `plusCS` oneBinder
letBndrStats :: TopLevelFlag -> Var -> CoreStats
letBndrStats top_lvl v
| isTyVar v || isTopLevel top_lvl = bndrStats v
- | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats
- | otherwise = oneTM { cs_vb = 1 } `plusCS` ty_stats
+ | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats `plusCS` oneBinder
+ | otherwise = oneTM { cs_vb = 1 } `plusCS` ty_stats `plusCS` oneBinder
where
ty_stats = tyStats (varType v)
@@ -89,7 +93,7 @@ altStats (Alt _ bs r) = altBndrStats bs `plusCS` exprStats r
altBndrStats :: [Var] -> CoreStats
-- Charge one for the alternative, not for each binder
-altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs
+altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs `plusCS` zeroCS { cs_bs = length vs }
tyStats :: Type -> CoreStats
tyStats ty = zeroCS { cs_ty = typeSize ty }
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -2153,7 +2153,8 @@ cpCloneBndr env bndr
-- Drop (now-useless) rules/unfoldings
-- See Note [Drop unfoldings and rules]
-- and Note [Preserve evaluatedness] in GHC.Core.Tidy
- ; let unfolding' = trimUnfolding (realIdUnfolding bndr)
+ -- And force it.. otherwise the old unfolding is just retained.
+ ; let !unfolding' = trimUnfolding (realIdUnfolding bndr)
-- Simplifier will set the Id's unfolding
bndr'' = bndr' `setIdUnfolding` unfolding'
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -1285,12 +1285,13 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf
--------- Unfolding ------------
unf_info = realUnfoldingInfo idinfo
- unfold_info
+ -- Force this, otherwise the old unfolding is retained
+ !unfold_info
| isCompulsoryUnfolding unf_info || show_unfold
= tidyUnfolding rhs_tidy_env unf_info unf_from_rhs
| otherwise
= minimal_unfold_info
- minimal_unfold_info = trimUnfolding unf_info
+ !minimal_unfold_info = trimUnfolding unf_info
unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs
-- NB: do *not* expose the worker if show_unfold is off,
-- because that means this thing is a loop breaker or
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04faaf347948e883f7b3d4978b3b59dfe6b46ea...5353d311d2da4aee9405b61fcc41f056963a5365
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04faaf347948e883f7b3d4978b3b59dfe6b46ea...5353d311d2da4aee9405b61fcc41f056963a5365
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/20220810/46202850/attachment-0001.html>
More information about the ghc-commits
mailing list