Andreas Klebinger pushed to branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC Commits: 013fe3d2 by Andreas Klebinger at 2026-09-13T08:49:03+02:00 Tweak inlining discout for unary class ops. Count the cost of applying the extra arguments to the result of a class op being applied to a unary class dictionary. That is if we have `(op d) x y z` charge for x y z even if we don't carge for the class op application. Fixes #27802 - - - - - 2 changed files: - + changelog.d/27802-classop-arg-size - compiler/GHC/Core/Unfold.hs Changes: ===================================== changelog.d/27802-classop-arg-size ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: For code like `m x y z` where m is a class method of a unary type class + we now account (again) for the size of applying the x/y/z arguments. +mrs: !16675 +issues: #27802 ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Core.Utils import GHC.Core.DataCon import GHC.Core.Type import GHC.Core.Class( Class ) -import GHC.Core.Predicate( isUnaryClass ) +import GHC.Core.Predicate( isUnaryClass, isDictId ) import GHC.Types.Id import GHC.Types.Literal @@ -782,16 +782,26 @@ classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize classOpSize _opts _cls _top_args [] = sizeZero -- A non-applied classop classOpSize opts cls top_args (dict_arg:other_val_args) - = SizeIs size (arg_discount dict_arg) 0 + = SizeIs size dict_arg_discount 0 where - size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon - | otherwise = 20 + (10 * length other_val_args) + -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon + op_app_size = if isUnaryClass cls then 0 else 20 + + -- Size penalty for applying the extracted class method to it's + -- arguments. + method_app_size + | null other_val_args = 0 + | otherwise = callSize (length other_val_args) + + size = op_app_size + method_app_size -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function - arg_discount (Cast arg _co) = arg_discount arg - arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount) - arg_discount _ = emptyBag + dict_arg_discount = case getIdFromTrivialExpr_maybe dict_arg of + Nothing -> emptyBag + Just dict + | dict `elem` top_args -> unitBag (dict, dict_discount) + | otherwise -> emptyBag -- If we have (class-op d arg1 .. argn) then it's super-good to inline -- to expose `d`; not only can we do the dictionary selection @@ -802,6 +812,12 @@ classOpSize opts cls top_args (dict_arg:other_val_args) | null other_val_args = unfoldingDictDiscount opts | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts + isTopArgDict expr + | Just v <- getIdFromTrivialExpr_maybe expr + = v `elem` top_args + | otherwise + = False + -- | The size of a function call callSize :: Int -- ^ number of value args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/013fe3d281480c9c06d14edc7243d77a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/013fe3d281480c9c06d14edc7243d77a... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help