[Git][ghc/ghc][wip/T17910] Inline data structures more aggressively again

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Thu Oct 12 11:09:20 UTC 2023



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


Commits:
d2a6c708 by Simon Peyton Jones at 2023-10-12T12:08:50+01:00
Inline data structures more aggressively again

- - - - -


4 changed files:

- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -54,7 +54,7 @@ import GHC.Core.Utils
 import GHC.Core.DataCon
 import GHC.Core.TyCon     ( tyConArity )
 import GHC.Core.TyCon.RecWalk     ( initRecTc, checkRecTc )
-import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy )
+import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy, isCallStackTy )
 import GHC.Core.Multiplicity
 
 -- We have two sorts of substitution:
@@ -1461,7 +1461,7 @@ myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty
     cheap_dict = case mb_ty of
                      Nothing -> False
                      Just ty -> (ao_dicts_cheap opts && isDictTy ty)
-                                || isCallStackPredTy ty
+                                || isCallStackPredTy ty || isCallStackTy ty
         -- See Note [Eta expanding through dictionaries]
         -- See Note [Eta expanding through CallStacks]
 


=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -1095,14 +1095,13 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs
 
 mkNonRecRhsCtxt :: TopLevelFlag -> Id -> Unfolding -> OccEncl
 -- Precondition: Id is not a join point
-mkNonRecRhsCtxt lvl bndr unf
+mkNonRecRhsCtxt _lvl bndr unf
   | certainly_inline = OccVanilla -- See Note [Cascading inlines]
   | otherwise        = OccRhs
   where
     certainly_inline -- See Note [Cascading inlines]
       = -- mkNonRecRhsCtxt is only used for non-join points, so occAnalBind
         -- has set the OccInfo for this binder before calling occAnalNonRecRhs
-        not (isTopLevel lvl) &&
         case idOccInfo bndr of
           OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 }
             -> active && not_stable


=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -279,7 +279,7 @@ getCoreToDo dflags hpt_rule_base extra_vars
         runWhen full_laziness $
            CoreDoFloatOutwards FloatOutSwitches {
                                  floatOutLambdas     = floatLamArgs dflags,
-                                 floatOutConstants   = True,
+                                 floatOutConstants   = True,  -- For SpecConstr and CSE
                                  floatOutOverSatApps = True,
                                  floatToTopLevelOnly = False },
                 -- nofib/spectral/hartel/wang doubles in speed if you


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Prelude hiding (head, init, last, tail)
 import qualified GHC.Prelude as Partial (head)
 
 import GHC.Core
-import GHC.Types.Literal ( isLitRubbish )
+import GHC.Core.Predicate( isDictId )
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Simplify.Inline
 import GHC.Core.Opt.Stats ( Tick(..) )
@@ -66,6 +66,7 @@ import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon )
 import GHC.Core.Multiplicity
 import GHC.Core.Opt.ConstantFold
 
+import GHC.Types.Literal ( isLitRubbish )
 import GHC.Types.Name
 import GHC.Types.Id
 import GHC.Types.Id.Info
@@ -1424,7 +1425,8 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
        | is_value_lam rhs, IsInteresting <- int_cxt
        = True
        | NotInsideLam <- in_lam
-       , not (isTopLevel top_lvl) || not (exprIsExpandable rhs)
+       , not (isDictId bndr)  -- Solely for SpecConstr
+--       , not (isTopLevel top_lvl) || not (exprIsExpandable rhs)
          -- Inline used-once things; except expandable things at top level
          -- These may arise from user code e.g.
          --     x = [1,2,3]



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2a6c708ed5b1118a8bd6906680b667b57f78ba4
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/20231012/16771c50/attachment-0001.html>


More information about the ghc-commits mailing list