[Git][ghc/ghc][wip/T22404] Remove the in-scope set from OccAnal
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Jul 18 20:07:25 UTC 2023
Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC
Commits:
49500bd2 by Simon Peyton Jones at 2023-07-18T21:06:22+01:00
Remove the in-scope set from OccAnal
- - - - -
1 changed file:
- compiler/GHC/Core/Opt/OccurAnal.hs
Changes:
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -666,7 +666,7 @@ Here are the consequences
* In the tricky (P3) we'll get an `andUDs` of
* OneOcc{occ_n_br=0} from the occurrences of `j`)
* OneOcc{occ_n_br=1} from the (f v)
- These are `andUDs` together, and hence `addOccInfo`, and hence
+ These are `andUDs` together in `addOccInfo`, and hence
`v` gets ManyOccs, just as it should. Clever!
There are a couple of tricky wrinkles
@@ -2151,32 +2151,34 @@ occAnalLamTail env expr
occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr
-- Does not markInsidLam etc for the outmost batch of lambdas
occ_anal_lam_tail env (Lam bndr expr)
- | isTyVar bndr
- = addInScope env [bndr] $ \env ->
- let !(WUD usage expr') = occ_anal_lam_tail env expr
- in WUD usage (Lam bndr expr')
- -- Important: Do not modify occ_encl, so that with a RHS like
- -- \(@ x) -> K @x (f @x)
- -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain
- -- from inlining f. See the beginning of Note [Cascading inlines].
-
- | otherwise -- So 'bndr' is an Id
- = addInScope env [bndr] $ \env ->
- let (env_one_shots', bndr1)
- = case occ_one_shots env of
- [] -> ([], bndr)
- (os : oss) -> (oss, updOneShotInfo bndr os)
- -- Use updOneShotInfo, not setOneShotInfo, as pre-existing
- -- one-shot info might be better than what we can infer, e.g.
- -- due to explicit use of the magic 'oneShot' function.
- -- See Note [The oneShot function]
-
- env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' }
- !(WUD usage expr') = occ_anal_lam_tail env1 expr
- bndr2 = tagLamBinder usage bndr1
- usage1 = usage `addManyOccs` coVarsOfType (idType bndr)
- -- usage1: see Note [Gather occurrences of coercion variables]
- in WUD usage1 (Lam bndr2 expr')
+ = go env [bndr] expr
+ where
+ go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr
+ go env rev_bndrs (Lam bndr expr)
+ | isTyVar bndr
+ = go env (bndr:rev_bndrs) expr
+ -- Important: Do not modify occ_encl, so that with a RHS like
+ -- \(@ x) -> K @x (f @x)
+ -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain
+ -- from inlining f. See the beginning of Note [Cascading inlines].
+
+ | otherwise
+ = let (env_one_shots', bndr1)
+ = case occ_one_shots env of
+ [] -> ([], bndr)
+ (os : oss) -> (oss, updOneShotInfo bndr os)
+ -- Use updOneShotInfo, not setOneShotInfo, as pre-existing
+ -- one-shot info might be better than what we can infer, e.g.
+ -- due to explicit use of the magic 'oneShot' function.
+ -- See Note [The oneShot function]
+ env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' }
+ in go env1 (bndr1 : rev_bndrs) expr
+
+ go env rev_bndrs expr
+ = addInScope env rev_bndrs $ \env ->
+ let !(WUD usage expr') = occ_anal_lam_tail env expr
+ in WUD (usage `addLamCoVarOccs` rev_bndrs) expr'
+ -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables]
-- For casts, keep going in the same lambda-group
-- See Note [Occurrence analysis for lambda binders]
@@ -2785,8 +2787,6 @@ data OccEnv
, occ_rule_act :: Activation -> Bool -- Which rules are active
-- See Note [Finding rule RHS free vars]
- , occ_in_scope :: VarSet -- Set of variables in scope
-
-- See Note [The binder-swap substitution]
-- If x :-> (y, co) is in the env,
-- then please replace x by (y |> mco)
@@ -2834,8 +2834,7 @@ type OneShots = [OneShotInfo]
initOccEnv :: OccEnv
initOccEnv
- = OccEnv { occ_in_scope = emptyVarSet
- , occ_encl = OccVanilla
+ = OccEnv { occ_encl = OccVanilla
, occ_one_shots = []
-- To be conservative, we say that all
@@ -2911,40 +2910,58 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of
addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a)
-> WithUsageDetails a
-- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind
-addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points })
+addInScope env@(OccEnv { occ_join_points = join_points })
bndrs thing_inside
- | not (any (`elemVarSet` in_scope) bndrs)
+ | not bad_joins
= -- No shadowing here; fast path for this common case
- fix_up_uds (thing_inside env_w_bndrs)
+ del_bndrs_from_uds $
+ thing_inside $
+ drop_shadowed_swaps $
+ env
| otherwise -- Shadowing! Lots of things to do
- = fix_up_uds $
- add_bad_joins $
- thing_inside $
+ = add_bad_joins $
+ del_bndrs_from_uds $
+ thing_inside $
drop_shadowed_swaps $
drop_shadowed_joins $
- env_w_bndrs
+ env
where
- env_w_bndrs = env { occ_in_scope = in_scope `extendVarSetList` bndrs }
+ bndr_set :: UniqSet Var
+ bndr_set = mkVarSet bndrs
+
+ bndr_fm :: UniqFM Var Var
+ bndr_fm = getUniqSet bndr_set
+
+ -- bad_joins is true if it would be wrong to push occ_join_points inwards
+ -- (a) `bndrs` includes any of the occ_join_points
+ -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points
+ bad_joins :: Bool
+ bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points
+
+ is_bad :: Unique -> OccInfoEnv -> Bool -> Bool
+ is_bad uniq join_uds rest
+ = uniq `elemUniqSet_Directly` bndr_set ||
+ not (bndr_fm `disjointUFM` join_uds) ||
+ rest
drop_shadowed_swaps :: OccEnv -> OccEnv
-- See Note [The binder-swap substitution] (BS3)
drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars })
- | any (`elemVarSet` bs_rng_vars) bndrs
+ | bs_rng_vars `disjointUniqSets` bndr_set
= env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet }
| otherwise
- = env { occ_bs_env = swap_env `delVarEnvList` bndrs }
+ = env { occ_bs_env = swap_env `minusUFM` bndr_fm }
drop_shadowed_joins :: OccEnv -> OccEnv
-- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2)
--- drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs }
drop_shadowed_joins env = env { occ_join_points = emptyVarEnv }
- fix_up_uds :: WithUsageDetails a -> WithUsageDetails a
+ del_bndrs_from_uds :: WithUsageDetails a -> WithUsageDetails a
-- Remove usage for bndrs
-- Add usage info for CoVars used in the types of bndrs
- fix_up_uds (WUD uds res) = WUD (uds `delDetails` bndrs) res
+ del_bndrs_from_uds (WUD uds res) = WUD (uds `delDetails` bndr_fm) res
add_bad_joins :: WithUsageDetails a -> WithUsageDetails a
-- Add usage info for occ_join_points that we cannot push inwardsa
@@ -2966,14 +2983,6 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points
| uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env
| otherwise = env
-{-
- bad_joins, good_joins :: IdEnv UsageDetails
- (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points
-
- bad_join_rhs :: UsageDetails -> Bool
- bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs
--}
-
addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv
addJoinPoint env bndr rhs_uds
| isEmptyVarEnv zeroed_form
@@ -3511,6 +3520,12 @@ addManyOccs uds var_set
add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set
-- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes
+addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails
+-- Add any CoVars free in the type of a lambda-binder
+-- See Note [Gather occurrences of coercion variables]
+addLamCoVarOccs uds bndrs
+ = uds `addManyOccs` coVarsOfTypes [ idType id | id <- bndrs, isId id ]
+
emptyDetails :: UsageDetails
emptyDetails = mkSimpleDetails emptyVarEnv
@@ -3533,16 +3548,16 @@ emptyDetails = UD { ud_env = emptyVarEnv
isEmptyDetails :: UsageDetails -> Bool
isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env
-delDetails :: UsageDetails -> [Id] -> UsageDetails
+delDetails :: UsageDetails -> UniqFM Var a -> UsageDetails
-- Delete these binders from the UsageDetails
delDetails (UD { ud_env = env
, ud_z_many = z_many
, ud_z_in_lam = z_in_lam
- , ud_z_tail = z_tail }) bndrs
- = UD { ud_env = env `delVarEnvList` bndrs
- , ud_z_many = z_many `delVarEnvList` bndrs
- , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs
- , ud_z_tail = z_tail `delVarEnvList` bndrs }
+ , ud_z_tail = z_tail }) bndr_fm
+ = UD { ud_env = env `minusUFM` bndr_fm
+ , ud_z_many = z_many `minusUFM` bndr_fm
+ , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm
+ , ud_z_tail = z_tail `minusUFM` bndr_fm }
markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail
:: UsageDetails -> UsageDetails
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49500bd205a81a65dbb50f6a822a843046a95fbf
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49500bd205a81a65dbb50f6a822a843046a95fbf
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/20230718/6c1776c8/attachment-0001.html>
More information about the ghc-commits
mailing list