[Git][ghc/ghc][wip/T17910] Work in progress...

[Simon Peyton Jones (@simonpj)]

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


Commits:
d869d536 by Simon Peyton Jones at 2023-08-08T17:48:25+01:00
Work in progress...

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1412,22 +1412,38 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
   , Just inl <- maybeUnfoldingTemplate unf   = Just $! (extend_subst_with inl)
   | otherwise                                = Nothing
   where
-    unf = idUnfolding bndr
+    unf         = idUnfolding bndr
+    inline_prag = idInlinePragma bndr
     extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs)
 
+    pre_inline_unconditionally = sePreInline env
+    active = isActive (sePhase env) (inlinePragmaActivation inline_prag)
+             -- See Note [pre/postInlineUnconditionally in gentle mode]
+
     one_occ IAmDead = True -- Happens in ((\x.1) v)
+    one_occ OneOcc{ occ_n_br = 1, occ_in_lam = in_lam, occ_int_cxt = int_cxt }
+       | is_value_lam rhs, IsInteresting <- int_cxt
+       = True
+       | NotInsideLam <- in_lam
+       , not (isTopLevel top_lvl) || not (exprIsExpandable rhs)
+       = True
+       | otherwise
+       = False
+    one_occ _ = False
+
+    is_value_lam (Lam b e)  = isRuntimeVar b || is_value_lam e
+    is_value_lam (Tick t e) = not (tickishIsCode t) && is_value_lam e
+    is_value_lam _          = False
+
+{-
     one_occ OneOcc{ occ_n_br   = 1
+
                   , occ_in_lam = NotInsideLam }   = isNotTopLevel top_lvl || early_phase
     one_occ OneOcc{ occ_n_br   = 1
                   , occ_in_lam = IsInsideLam
                   , occ_int_cxt = IsInteresting } = canInlineInLam rhs
     one_occ _                                     = False
 
-    pre_inline_unconditionally = sePreInline env
-    active = isActive (sePhase env) (inlinePragmaActivation inline_prag)
-             -- See Note [pre/postInlineUnconditionally in gentle mode]
-    inline_prag = idInlinePragma bndr
-
 -- Be very careful before inlining inside a lambda, because (a) we must not
 -- invalidate occurrence information, and (b) we want to avoid pushing a
 -- single allocation (here) into multiple allocations (inside lambda).
@@ -1456,7 +1472,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
       -- not ticks.  Counting ticks cannot be duplicated, and non-counting
       -- ticks around a Lam will disappear anyway.
 
-    early_phase = not (isExpandableUnfolding unf)
+    early_phase = hasSomeUnfolding unf && not (isExpandableUnfolding unf)
                       -- /Do/ inline  xs = build g, if it is used once!
                   -- False  -- See #17910
                   -- sePhase env /= FinalPhase
@@ -1474,6 +1490,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
     -- simplifications).  Until phase zero we take no special notice of
     -- top level things, but then we become more leery about inlining
     -- them.
+-}
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -1343,10 +1343,8 @@ expansion.  Specifically:
 exprIsExpandable :: CoreExpr -> Bool
 -- See Note [exprIsExpandable]
 exprIsExpandable e
-  = ok e
+  = go 0 e
   where
-    ok e = go 0 e
-
     -- n is the number of value arguments
     go n (Var v)                      = isExpandableApp v n
     go _ (Lit {})                     = True
@@ -1357,7 +1355,7 @@ exprIsExpandable e
                     | otherwise       = go n e
     go n (Lam x e)  | isRuntimeVar x  = n==0 || go (n-1) e
                     | otherwise       = go n e
-    go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e
+    go n (App f e)  | isRuntimeArg e  = go (n+1) f && exprIsWorkFree e
                     | otherwise       = go n f
     go _ (Case {})                    = False
     go _ (Let {})                     = False



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d869d5361bb3e79b0ea67416eb0ac01789d41973
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/20230808/db7c8b53/attachment-0001.html>