[Git][ghc/ghc][wip/spj-unf-size] Wibbles

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC


Commits:
6ae7c217 by Simon Peyton Jones at 2023-10-23T08:55:56+01:00
Wibbles

- - - - -


2 changed files:

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


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -31,7 +31,7 @@ module GHC.Core.Opt.Simplify.Utils (
 
         -- The CallCtxt type
         CallCtxt(..),
-        
+
         -- ArgInfo
         ArgInfo(..), ArgSpec(..), RewriteCall(..), mkArgInfo,
         addValArgTo, addCastTo, addTyArgTo,


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -585,7 +585,7 @@ exprTree opts args expr
       | Just v <- recordCaseOf vs scrut
       = -- pprTrace "recordCaseOf" (ppr v $$ ppr lvs $$ ppr scrut $$ ppr alts) $
         go vs scrut `et_add`
-        etZero { et_cases = unitBag (CaseOf v b (map (alt_alt_tree v) alts)) }
+        etOneCase (CaseOf v b (map (alt_alt_tree v) alts))
       where
         alt_alt_tree :: Id -> Alt Var -> AltTree
         alt_alt_tree v (Alt con bs rhs)
@@ -729,7 +729,7 @@ classOpSize opts vs fn val_args
   , Just dict <- recordCaseOf vs arg1
   = warnPprTrace (not (isId dict)) "classOpSize" (ppr fn <+> ppr val_args) $
     vanillaCallSize (length val_args) `etAddN`
-    etZero { et_cases = unitBag (ScrutOf dict (unfoldingDictDiscount opts)) }
+    etOneCase (ScrutOf dict (unfoldingDictDiscount opts))
            -- If the class op is scrutinising a lambda bound dictionary then
            -- give it a discount, to encourage the inlining of this function
            -- The actual discount is rather arbitrarily chosen
@@ -985,6 +985,8 @@ etAddAlt bOMB_OUT_SIZE (SizeIs { et_size = n1, et_cases = c1, et_ret = ret1 })
 etZero :: ExprTree
 etZero = SizeIs { et_size = 0, et_cases = emptyBag, et_ret = 0 }
 
+etOneCase :: CaseTree -> ExprTree
+etOneCase ct = SizeIs { et_size = 0, et_cases = unitBag ct, et_ret = 0 }
 
 {- *********************************************************************
 *                                                                      *



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ae7c21799125224a9dc0ced3e99f2f286bda0fb
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/20231023/eb20683a/attachment-0001.html>