[Git][ghc/ghc][wip/andreask/opt-calcUnfolding] Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size.

[Andreas Klebinger (@AndreasK)]

Andreas Klebinger pushed to branch wip/andreask/opt-calcUnfolding at Glasgow Haskell Compiler / GHC


Commits:
7e004b05 by Andreas Klebinger at 2022-08-13T15:08:38+02:00
Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size.

There is also no point in calcUnfoldingGuidance handling Ticks since it's
handlined inside sizeExpr already. So I removed that as well.

- - - - -


1 changed file:

- compiler/GHC/Core/Unfold.hs


Changes:

=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -57,7 +57,6 @@ import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Types.ForeignCall
 import GHC.Types.Name
-import GHC.Types.Tickish
 
 import qualified Data.ByteString as BS
 import Data.List (isPrefixOf)
@@ -231,44 +230,42 @@ calcUnfoldingGuidance
         -> Bool          -- Definitely a top-level, bottoming binding
         -> CoreExpr      -- Expression to look at
         -> UnfoldingGuidance
-calcUnfoldingGuidance opts is_top_bottoming (Tick t expr)
-  | not (tickishIsCode t)  -- non-code ticks don't matter for unfolding
-  = calcUnfoldingGuidance opts is_top_bottoming expr
-calcUnfoldingGuidance opts is_top_bottoming expr
-  = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of
-      TooBig -> UnfNever
-      SizeIs size cased_bndrs scrut_discount
-        | uncondInline expr n_val_bndrs size
-        -> UnfWhen { ug_unsat_ok = unSaturatedOk
-                   , ug_boring_ok =  boringCxtOk
-                   , ug_arity = n_val_bndrs }   -- Note [INLINE for small functions]
-
-        | is_top_bottoming
-        -> UnfNever   -- See Note [Do not inline top-level bottoming functions]
-
-        | otherwise
-        -> UnfIfGoodArgs { ug_args  = map (mk_discount cased_bndrs) val_bndrs
-                         , ug_size  = size
-                         , ug_res   = scrut_discount }
-
+calcUnfoldingGuidance !opts is_top_bottoming !expr
+  -- See Note [Do not inline top-level bottoming functions]
+  | is_top_bottoming = UnfNever
+  | otherwise = calc opts expr
   where
+    calc opts expr
+      = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of
+          TooBig -> UnfNever
+          SizeIs size cased_bndrs scrut_discount
+            | uncondInline expr n_val_bndrs size
+            -> UnfWhen { ug_unsat_ok = unSaturatedOk
+                      , ug_boring_ok =  boringCxtOk
+                      , ug_arity = n_val_bndrs }   -- Note [INLINE for small functions]
+
+            | otherwise
+            -> UnfIfGoodArgs { ug_args  = map (mk_discount cased_bndrs) val_bndrs
+                            , ug_size  = size
+                            , ug_res   = scrut_discount }
+
     (bndrs, body) = collectBinders expr
     bOMB_OUT_SIZE = unfoldingCreationThreshold opts
-           -- Bomb out if size gets bigger than this
+          -- Bomb out if size gets bigger than this
     val_bndrs   = filter isId bndrs
     n_val_bndrs = length val_bndrs
 
     mk_discount :: Bag (Id,Int) -> Id -> Int
     mk_discount cbs bndr = foldl' combine 0 cbs
-           where
-             combine acc (bndr', disc)
-               | bndr == bndr' = acc `plus_disc` disc
-               | otherwise     = acc
-
-             plus_disc :: Int -> Int -> Int
-             plus_disc | isFunTy (idType bndr) = max
-                       | otherwise             = (+)
-             -- See Note [Function and non-function discounts]
+          where
+            combine acc (bndr', disc)
+              | bndr == bndr' = acc `plus_disc` disc
+              | otherwise     = acc
+
+            plus_disc :: Int -> Int -> Int
+            plus_disc | isFunTy (idType bndr) = max
+                      | otherwise             = (+)
+              -- See Note [Function and non-function discounts]
 
 {- Note [Inline unsafeCoerce]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e004b05598d68d32de047235cee6a0150c03e46
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/20220813/7330bce5/attachment-0001.html>