[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