[Git][ghc/ghc][wip/spj-unf-size] Charge for case eval, instead of giving a discount

[Simon Peyton Jones (@simonpj)]

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


Commits:
2543041d by Simon Peyton Jones at 2023-11-24T17:03:45+00:00
Charge for case eval, instead of giving a discount

   caseSize scrut_id alts = caseEvalSize scrut_id
                            + 2 * length alts

- - - - -


1 changed file:

- compiler/GHC/Core/Unfold.hs


Changes:

=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -673,7 +673,7 @@ exprTree opts args expr
       = if   remaining_case_depth > 0
         then do { alts' <- mapM (alt_alt_tree scrut_id) alts
                 ; etCaseOf bOMB_OUT_SIZE scrut_id b alts' }
-        else Just (etScrutOf scrut_id caseElimDiscount) `met_add`
+        else Just (etScrutOf scrut_id (caseEvalSize scrut_id)) `met_add`
               -- When this scrutinee has structure, we expect to eliminate the case
              go_alts remaining_case_depth vs b alts
       where
@@ -904,16 +904,21 @@ caseSize :: Id -> [alt] -> Size
 -- save live variables, push a return address create an info table
 -- An unlifted case is just a conditional; and if there is only one
 -- alternative, it's not even a conditional, hence size zero
-caseSize scrut_id alts
-  | isUnliftedType (idType scrut_id)
+caseSize scrut_id alts = caseEvalSize scrut_id
+                         + 2 * length alts
+  -- Charge for the 'eval' then a small amount more for each alternative
+{-
   = if isSingleton alts then 0
                         else 5 * length alts
   | otherwise
   = 10 * length alts
+-}
 
-caseElimDiscount :: Discount
--- Bonus for eliminating a case
-caseElimDiscount = 15
+caseEvalSize :: Id -> Size
+-- Accounts for the size of the 'eval' code
+caseEvalSize scrut_id
+  | isUnliftedType (idType scrut_id) = 0
+  | otherwise                        = 20
 
 {- Note [Bale out on very wide case expressions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1292,8 +1297,7 @@ caseTreeSize ic (CaseOf scrut_var case_bndr alts)
                      -- In DEFAULT case, bs is empty, so extending is a no-op
          -> assertPpr ((alt_con == DEFAULT) || (bndrs `equalLength` args))
                       (ppr arg_digest $$ ppr at) $
-            exprTreeSize ic' rhs - caseElimDiscount
-              -- Take off an extra discount for eliminating the case expression itself
+            exprTreeSize ic' rhs
 
          | otherwise  -- Happens for empty alternatives
          -> caseAltsSize ic case_bndr alts



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2543041d905315f7ab7adb207640ca827d25b0ff
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/20231124/f352220f/attachment-0001.html>