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

Andreas Klebinger (@AndreasK) gitlab at gitlab.haskell.org
Sat Aug 13 17:25:46 UTC 2022



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


Commits:
3372c54c by Andreas Klebinger at 2022-08-13T19:25:24+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 }
-
+  -- 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/3372c54cadb9b4fdf74c909de36d43bc2309a8c8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3372c54cadb9b4fdf74c909de36d43bc2309a8c8
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/2b2e671a/attachment-0001.html>


More information about the ghc-commits mailing list