Andreas Klebinger pushed to branch wip/andreask/occ_anal_tuning at Glasgow Haskell Compiler / GHC
Commits:
-
19b591cd
by Andreas Klebinger at 2025-10-08T09:05:48+02:00
4 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Env.hs
Changes:
| ... | ... | @@ -10,6 +10,10 @@ |
| 10 | 10 | -- bad for performance, so I increased the limit to allow it to unbox
|
| 11 | 11 | -- consistently.
|
| 12 | 12 | |
| 13 | +-- {-# OPTIONS_GHC -ddump-simpl -ddump-stg -dumpdir dumps -ddump-to-file #-}
|
|
| 14 | +-- {-# OPTIONS_GHC -fdistinct-constructor-tables -finfo-table-map #-}
|
|
| 15 | +-- {-# OPTIONS_GHC -ticky -ticky-allocd -ticky-LNE #-}
|
|
| 16 | + |
|
| 13 | 17 | {-
|
| 14 | 18 | (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
|
| 15 | 19 | |
| ... | ... | @@ -984,7 +988,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine |
| 984 | 988 | = -- Analyse the RHS and /then/ the body
|
| 985 | 989 | let -- Analyse the rhs first, generating rhs_uds
|
| 986 | 990 | !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs
|
| 987 | - rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of
|
|
| 991 | + rhs_uds = foldl1' orUDs rhs_uds_s -- NB: orUDs. See (W4) of
|
|
| 988 | 992 | -- Note [Occurrence analysis for join points]
|
| 989 | 993 | |
| 990 | 994 | -- Now analyse the body, adding the join point
|
| ... | ... | @@ -3650,8 +3654,10 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a |
| 3650 | 3654 | -------------------
|
| 3651 | 3655 | -- UsageDetails API
|
| 3652 | 3656 | |
| 3653 | -andUDs, orUDs
|
|
| 3654 | - :: UsageDetails -> UsageDetails -> UsageDetails
|
|
| 3657 | +-- {-# NOINLINE andUDs #-}
|
|
| 3658 | +-- {-# NOINLINE orUDs #-}
|
|
| 3659 | +andUDs:: UsageDetails -> UsageDetails -> UsageDetails
|
|
| 3660 | +orUDs :: UsageDetails -> UsageDetails -> UsageDetails
|
|
| 3655 | 3661 | andUDs = combineUsageDetailsWith andLocalOcc
|
| 3656 | 3662 | orUDs = combineUsageDetailsWith orLocalOcc
|
| 3657 | 3663 | |
| ... | ... | @@ -3760,16 +3766,17 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs |
| 3760 | 3766 | combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc)
|
| 3761 | 3767 | -> UsageDetails -> UsageDetails -> UsageDetails
|
| 3762 | 3768 | {-# INLINE combineUsageDetailsWith #-}
|
| 3769 | +{-# SCC combineUsageDetailsWith #-}
|
|
| 3763 | 3770 | combineUsageDetailsWith plus_occ_info
|
| 3764 | 3771 | uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 })
|
| 3765 | 3772 | uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 })
|
| 3766 | 3773 | | isEmptyVarEnv env1 = uds2
|
| 3767 | 3774 | | isEmptyVarEnv env2 = uds1
|
| 3768 | 3775 | | otherwise
|
| 3769 | - = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2
|
|
| 3770 | - , ud_z_many = plusVarEnv z_many1 z_many2
|
|
| 3771 | - , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2
|
|
| 3772 | - , ud_z_tail = plusVarEnv z_tail1 z_tail2 }
|
|
| 3776 | + = UD { ud_env = {-# SCC ud_env #-} strictPlusVarEnv_C plus_occ_info env1 env2
|
|
| 3777 | + , ud_z_many = {-# SCC ud_z_many #-} strictPlusVarEnv z_many1 z_many2
|
|
| 3778 | + , ud_z_in_lam = {-# SCC ud_z_in_lam #-} strictPlusVarEnv z_in_lam1 z_in_lam2
|
|
| 3779 | + , ud_z_tail = {-# SCC ud_z_tail #-} strictPlusVarEnv z_tail1 z_tail2 }
|
|
| 3773 | 3780 | |
| 3774 | 3781 | lookupLetOccInfo :: UsageDetails -> Id -> OccInfo
|
| 3775 | 3782 | -- Don't use locally-generated occ_info for exported (visible-elsewhere)
|
| ... | ... | @@ -3,6 +3,7 @@ |
| 3 | 3 | |
| 4 | 4 | {-# OPTIONS_HADDOCK not-home #-}
|
| 5 | 5 | {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
|
| 6 | +{-# OPTIONS_GHC -ddump-simpl -ddump-stg-final -ddump-to-file -dumpdir dumps #-}
|
|
| 6 | 7 | |
| 7 | 8 | |
| 8 | 9 | -----------------------------------------------------------------------------
|
| ... | ... | @@ -51,7 +51,9 @@ module GHC.Types.Unique.FM ( |
| 51 | 51 | delListFromUFM,
|
| 52 | 52 | delListFromUFM_Directly,
|
| 53 | 53 | plusUFM,
|
| 54 | + strictPlusUFM,
|
|
| 54 | 55 | plusUFM_C,
|
| 56 | + strictPlusUFM_C,
|
|
| 55 | 57 | plusUFM_CD,
|
| 56 | 58 | plusUFM_CD2,
|
| 57 | 59 | mergeUFM,
|
| ... | ... | @@ -251,16 +253,24 @@ delListFromUFM_Directly = foldl' delFromUFM_Directly |
| 251 | 253 | delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt
|
| 252 | 254 | delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
|
| 253 | 255 | |
| 254 | --- Bindings in right argument shadow those in the left
|
|
| 256 | +-- | Bindings in right argument shadow those in the left.
|
|
| 257 | +--
|
|
| 258 | +-- Unlike containers this union is right-biased for historic reasons.
|
|
| 255 | 259 | plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt
|
| 256 | --- M.union is left-biased, plusUFM should be right-biased.
|
|
| 257 | 260 | plusUFM (UFM x) (UFM y) = UFM (M.union y x)
|
| 258 | 261 | -- Note (M.union y x), with arguments flipped
|
| 259 | 262 | -- M.union is left-biased, plusUFM should be right-biased.
|
| 260 | 263 | |
| 264 | +-- | Right biased
|
|
| 265 | +strictPlusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt
|
|
| 266 | +strictPlusUFM (UFM x) (UFM y) = UFM (MS.union y x)
|
|
| 267 | + |
|
| 261 | 268 | plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
|
| 262 | 269 | plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
|
| 263 | 270 | |
| 271 | +strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
|
|
| 272 | +strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y)
|
|
| 273 | + |
|
| 264 | 274 | -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
|
| 265 | 275 | -- combinding function and `d1` resp. `d2` as the default value if
|
| 266 | 276 | -- there is no entry in `m1` reps. `m2`. The domain is the union of
|
| ... | ... | @@ -12,7 +12,8 @@ module GHC.Types.Var.Env ( |
| 12 | 12 | elemVarEnv, disjointVarEnv, anyVarEnv,
|
| 13 | 13 | extendVarEnv, extendVarEnv_C, extendVarEnv_Acc,
|
| 14 | 14 | extendVarEnvList,
|
| 15 | - plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
|
|
| 15 | + strictPlusVarEnv, plusVarEnv, plusVarEnv_C, strictPlusVarEnv_C,
|
|
| 16 | + plusVarEnv_CD, plusMaybeVarEnv_C,
|
|
| 16 | 17 | plusVarEnvList, alterVarEnv,
|
| 17 | 18 | delVarEnvList, delVarEnv,
|
| 18 | 19 | minusVarEnv,
|
| ... | ... | @@ -511,6 +512,7 @@ extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a |
| 511 | 512 | extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
|
| 512 | 513 | extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
|
| 513 | 514 | plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
|
| 515 | +strictPlusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
|
|
| 514 | 516 | plusVarEnvList :: [VarEnv a] -> VarEnv a
|
| 515 | 517 | extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
|
| 516 | 518 | varEnvDomain :: VarEnv elt -> UnVarSet
|
| ... | ... | @@ -522,6 +524,7 @@ delVarEnvList :: Foldable f => VarEnv a -> f Var -> VarEnv a |
| 522 | 524 | delVarEnv :: VarEnv a -> Var -> VarEnv a
|
| 523 | 525 | minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
|
| 524 | 526 | plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
|
| 527 | +strictPlusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
|
|
| 525 | 528 | plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
|
| 526 | 529 | plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a
|
| 527 | 530 | mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
|
| ... | ... | @@ -548,6 +551,7 @@ extendVarEnv_C = addToUFM_C |
| 548 | 551 | extendVarEnv_Acc = addToUFM_Acc
|
| 549 | 552 | extendVarEnvList = addListToUFM
|
| 550 | 553 | plusVarEnv_C = plusUFM_C
|
| 554 | +strictPlusVarEnv_C = strictPlusUFM_C
|
|
| 551 | 555 | plusVarEnv_CD = plusUFM_CD
|
| 552 | 556 | plusMaybeVarEnv_C = plusMaybeUFM_C
|
| 553 | 557 | delVarEnvList = delListFromUFM
|
| ... | ... | @@ -556,6 +560,7 @@ delVarEnvList = delListFromUFM |
| 556 | 560 | delVarEnv = delFromUFM
|
| 557 | 561 | minusVarEnv = minusUFM
|
| 558 | 562 | plusVarEnv = plusUFM
|
| 563 | +strictPlusVarEnv = strictPlusUFM
|
|
| 559 | 564 | plusVarEnvList = plusUFMList
|
| 560 | 565 | -- lookupVarEnv is very hot (in part due to being called by substTyVar),
|
| 561 | 566 | -- if it's not inlined than the mere allocation of the Just constructor causes
|