[Git][ghc/ghc][wip/T22404] Wibbles

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC


Commits:
cce16400 by Simon Peyton Jones at 2023-01-05T17:34:56+00:00
Wibbles

- - - - -


1 changed file:

- compiler/GHC/Core/Opt/OccurAnal.hs


Changes:

=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -780,9 +780,10 @@ occAnalNonRecIdBind !env imp_rule_edges tagged_bndr rhs
     is_join_point = isJust mb_join_arity
 
     --------- Right hand side ---------
-    env1 | is_join_point    = env  -- See Note [Join point RHSs]
-         | certainly_inline = env  -- See Note [Cascading inlines]
-         | otherwise        = rhsCtxt env
+    env1 = setRhsCtxt rhs_ctxt env
+    rhs_ctxt | certainly_inline = OccVanilla -- See Note [Cascading inlines]
+             | is_join_point    = OccVanilla -- See Note [Join point RHSs]
+             | otherwise        = OccRhs
 
     -- See Note [Sources of one-shot information]
     rhs_env = env1 { occ_one_shots = argOneShots dmd }
@@ -1436,7 +1437,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs)
     -- Do not use occAnalRhs because we don't yet know the final
     -- answer for mb_join_arity; instead, do the occAnalLam call from
     -- occAnalRhs, and postpone adjustRhsUsage until occAnalRec
-    rhs_env                         = rhsCtxt env
+    rhs_env                         = setRhsCtxt OccRhs env
     (WithUsageDetails rhs_uds rhs') = occAnalLam rhs_env rhs
 
     --------- Unfolding ---------
@@ -1858,7 +1859,7 @@ occAnalLam env (Lam bndr body)
 -- For casts, keep going in the same lambda-group
 -- See Note [Occurrence analysis for lambda binders]
 occAnalLam env (Cast expr co)
-  = let  (WithUsageDetails usage expr') = occAnalLam env expr
+  = let  WithUsageDetails usage expr' = occAnalLam env expr
          -- usage1: see Note [Gather occurrences of coercion variables]
          usage1 = addManyOccs usage (coVarsOfCo co)
 
@@ -2055,7 +2056,7 @@ a big deal.
 
 Note [Cascading inlines]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-By default we use an rhsCtxt for the RHS of a binding.  This tells the
+By default we use an OccRhs for the RHS of a binding.  This tells the
 occ anal n that it's looking at an RHS, which has an effect in
 occAnalApp.  In particular, for constructor applications, it makes
 the arguments appear to have NoOccInfo, so that we don't inline into
@@ -2076,7 +2077,7 @@ Result: multiple simplifier iterations.  Sigh.
 
 So, when analysing the RHS of x3 we notice that x3 will itself
 definitely inline the next time round, and so we analyse x3's rhs in
-an ordinary context, not rhsCtxt.  Hence the "certainly_inline" stuff.
+an OccVanilla context, not OccRhs.  Hence the "certainly_inline" stuff.
 
 Annoyingly, we have to approximate GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally.
 If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and
@@ -2569,8 +2570,8 @@ scrutCtxt !env alts
      -- non-default alternative.  That in turn influences
      -- pre/postInlineUnconditionally.  Grep for "occ_int_cxt"!
 
-rhsCtxt :: OccEnv -> OccEnv
-rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] }
+setRhsCtxt :: OccEncl -> OccEnv -> OccEnv
+setRhsCtxt ctxt !env = env { occ_encl = ctxt, occ_one_shots = [] }
 
 valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots])
 valArgCtxt !env []
@@ -2599,19 +2600,13 @@ addInScope env@(OccEnv { occ_join_points = join_points }) bndrs thing_inside
 
     drop_shadowed_joins :: OccEnv -> OccEnv
     -- See Note [Occurrence analysis for join points]
-    drop_shadowed_joins env
-       | isEmptyVarEnv bad_joins
-       , not (any (`elemVarEnv` join_points) bndrs)
-                                 = env -- Non-allocating short cut; common case
-       | otherwise               = env { occ_join_points = good_joins `delVarEnvList` bndrs}
-       where
+    drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs}
 
     fix_up_uds :: WithUsageDetails a -> WithUsageDetails a
     -- Add usage info for (a) CoVars used in the types of bndrs
     -- and (b) occ_join_points that we cannot push inwards because of shadowing
     fix_up_uds (WithUsageDetails uds res)
-      = with_joins `seq`
-        WithUsageDetails with_joins res
+      = WithUsageDetails with_joins res
       where
         trimmed_uds      = uds `delDetails` bndrs
         with_co_var_occs = trimmed_uds `addManyOccs` coVarOccs bndrs



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cce16400259b52721f264b4b7dbb2d6b0e817dc4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cce16400259b52721f264b4b7dbb2d6b0e817dc4
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/20230105/22bfb56b/attachment-0001.html>