Andreas Klebinger pushed to branch wip/andreask/bomb_out at Glasgow Haskell Compiler / GHC Commits: d0d19520 by Andreas Klebinger at 2025-09-25T12:37:34+02:00 Fix missing bndr alloc - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -569,6 +569,7 @@ sizeExpr :: UnfoldingOpts -- Forcing bOMB_OUT_SIZE early prevents repeated -- unboxing of the Int argument. +-- {-# NOINLINE sizeExpr #-} sizeExpr opts !bOMB_OUT_SIZE top_args expr = size_up sizeZero expr where @@ -596,12 +597,12 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr | otherwise = size_up s e size_up s (Let (NonRec binder rhs) body) - = let rhs_s = size_up_rhs s (binder, rhs) - in size_up (stripDiscounts $ rhs_s `addSizeN` size_up_alloc binder) body + = let rhs_s = size_up_let s (binder, rhs) + in size_up (stripDiscounts $ rhs_s) body size_up s (Let (Rec pairs) body) - = size_up (stripDiscounts (foldr (flip size_up_rhs) s pairs)) + = size_up (stripDiscounts (foldr (flip size_up_let) s pairs)) body size_up s (Case e _ _ alts) = case nonEmpty alts of @@ -637,8 +638,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr -- that may eliminate allocation in the caller -- And it eliminates the case itself - | otherwise -> let case_s = size_up s e `addSizeNSD` case_size - in foldr (addAltSize . size_up_alt case_s) case_s alts + | otherwise -> foldr (addAltSize . size_up_alt s) + (size_up s e `addSizeNSD` case_size) + alts where is_top_arg (Var v) | v `elem` top_args = Just v @@ -647,6 +649,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr is_top_arg _ = Nothing where + case_size | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) | otherwise = sizeZero @@ -682,14 +685,14 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr | otherwise = False - size_up_rhs :: ExprSize -> (Id, CoreExpr) -> ExprSize - size_up_rhs s (bndr, rhs) + size_up_let :: ExprSize -> (Id, CoreExpr) -> ExprSize + size_up_let s (bndr, rhs) | JoinPoint join_arity <- idJoinPointHood bndr -- Skip arguments to join point , (_bndrs, body) <- collectNBinders join_arity rhs = size_up s body | otherwise - = size_up s rhs + = size_up s rhs `addSizeN` size_up_alloc bndr ------------ -- size_up_app is used when there's ONE OR MORE value args @@ -725,8 +728,8 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr -- size_up_alt returns on the alternatives size, not including the accumulated size passed in unless we reach TooBig size_up_alt TooBig _ = TooBig size_up_alt (SizeIs {_es_size_is=s}) (Alt _con _bndrs rhs) = - size_up (sizeN $ s + 10) rhs - `addSizeN` (-s) -- Why add and then subtract s? If the expression is already large we will bomb out early this way. + size_up (sizeN s) rhs + `addSizeN` (10 -s) -- Why add and then subtract s? If the expression is already large we will bomb out early this way. -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) @@ -780,6 +783,8 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr isZeroBitExpr (Tick _ e) = isZeroBitExpr e isZeroBitExpr _ = False +-- pprSizeCont txt s r = pprTrace txt (ppr (s,r,_es_size_is r - _es_size_is s)) r + -- | Finds a nominal size of a string literal. litSize :: Literal -> Int -- Used by GHC.Core.Unfold.sizeExpr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0d19520ffd1a3ccfc68ec05ae6df2fa... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0d19520ffd1a3ccfc68ec05ae6df2fa... You're receiving this email because of your account on gitlab.haskell.org.