[Git][ghc/ghc][wip/T22404] Remove the in-scope set from OccAnal
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Jul 18 21:53:06 UTC 2023
Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC
Commits:
78aae1b0 by Simon Peyton Jones at 2023-07-18T22:52:40+01:00
Remove the in-scope set from OccAnal
- - - - -
2 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/SimpleOpt.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,37 @@ 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
+ = let bndrs = reverse rev_bndrs in
+ addInScope env bndrs $ \env ->
+ let !(WUD usage expr') = occ_anal_lam_tail env expr
+ bndrs' = tagLamBinders usage bndrs
+ in WUD (usage `addLamCoVarOccs` bndrs)
+ (mkLams 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 +2790,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 +2837,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 +2913,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
- = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet }
+ | bs_rng_vars `disjointUniqSets` bndr_set
+ = env { occ_bs_env = swap_env `minusUFM` bndr_fm }
| otherwise
- = env { occ_bs_env = swap_env `delVarEnvList` bndrs }
+ = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet }
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 +2986,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 +3523,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 +3551,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
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -263,7 +263,6 @@ simple_opt_expr env expr
go lam@(Lam {}) = go_lam env [] lam
go (Case e b ty as)
- -- See Note [Getting the map/coerce RULE to work]
| isDeadBinder b
, Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e'
-- We don't need to be concerned about floats when looking for coerce.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aae1b094ea9b225fc696e9c33e9728a18ae2ee
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aae1b094ea9b225fc696e9c33e9728a18ae2ee
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/8da69428/attachment-0001.html>
More information about the ghc-commits
mailing list