[Git][ghc/ghc][wip/spj-unf-size] 2 commits: More small changes
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Nov 21 13:31:59 UTC 2023
Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC
Commits:
1507d4bf by Simon Peyton Jones at 2023-11-21T13:27:00+00:00
More small changes
* Result discounts like before -- on RhsCtxt
* Increase funAppDiscount and caseElimDiscount a bit
- - - - -
6b3918cc by Simon Peyton Jones at 2023-11-21T13:31:15+00:00
Add RULES for eqList on []
This gives us better code when you say
xs = [] or xs /= []
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Simplify/Inline.hs
- compiler/GHC/Core/Unfold.hs
- libraries/ghc-prim/GHC/Classes.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Inline.hs
=====================================
@@ -211,7 +211,8 @@ tryUnfolding logger env fn cont unf_template unf_cache guidance
some_benefit = calc_some_benefit uf_arity
enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
- UnfIfGoodArgs { ug_args = val_arg_bndrs, ug_tree = expr_tree }
+ UnfIfGoodArgs { ug_args = val_arg_bndrs
+ , ug_tree = expr_tree@(ExprTree { et_ret = ret_discount}) }
| unfoldingVeryAggressive opts
-> traceInline logger env fn str (mk_doc some_benefit extra_doc True) (Just unf_template)
| is_wf && some_benefit && small_enough
@@ -223,21 +224,15 @@ tryUnfolding logger env fn cont unf_template unf_cache guidance
some_benefit = calc_some_benefit n_bndrs
small_enough = adjusted_size <= unfoldingUseThreshold opts
rhs_size = exprTreeSize context expr_tree
- adjusted_size = rhs_size - call_size_discount + depth_penalty
+ adjusted_size = rhs_size - call_size_discount - actual_ret_discount + depth_penalty
-------- Compute the size of the ExprTree in this context -----------
- want_result
- | n_bndrs < n_val_args = True -- Over-saturated
- | otherwise = case cont_info of
- CaseCtxt -> True
- _ -> False
+ context = IC { ic_bound = bound_env
+ , ic_free = getFreeDigest }
bound_env = mkVarEnv (val_arg_bndrs `zip` (arg_infos ++ repeat ArgNoInfo))
-- Crucial to include /all/ val_arg_bndrs, lest we treat
-- them as free and use ic_free instead
- context = IC { ic_bound = bound_env
- , ic_free = getFreeDigest
- , ic_want_res = want_result }
in_scope = seInScope env
getFreeDigest :: Id -> ArgDigest -- The ArgDigest of a free variable
@@ -262,6 +257,23 @@ tryUnfolding logger env fn cont unf_template unf_cache guidance
arg_discount arg_info | hasArgInfo arg_info = 20
| otherwise = 10
+ actual_ret_discount | n_bndrs < n_val_args
+ = ret_discount
+ | otherwise
+ = case cont_info of
+ BoringCtxt -> 0
+ DiscArgCtxt -> 0
+ RuleArgCtxt -> 0
+ CaseCtxt -> ret_discount
+ ValAppCtxt -> ret_discount
+ RhsCtxt {} -> 40 `min` ret_discount
+ -- For RhsCtxt I suppose that exposing a data con is good in general
+ -- although 40 seems very arbitrary
+ --
+ -- `min` thresholding: res_discount can be very large when a
+ -- function returns constructors; but we only want to invoke
+ -- that large discount when there's a case continuation.
+
-- Adjust by the depth scaling
-- See Note [Avoid inlining into deeply nested cases]
depth_threshold = unfoldingCaseThreshold opts
@@ -650,6 +662,9 @@ exprDigest env e = go env e []
| Just con <- isDataConWorkId_maybe f
= ArgIsCon (DataAlt con) (map (exprDigest env) val_args)
+ | Just rhs <- expandUnfolding_maybe unfolding
+ = go (zapSubstEnv env) rhs val_args
+
-- | DFunUnfolding {} <- unfolding
| hasSomeUnfolding unfolding
= ArgIsNot [] -- We (slightly hackily) use ArgIsNot [] for dfun applications
@@ -663,12 +678,9 @@ exprDigest env e = go env e []
-- Actually in spectral/puzzle I found that we got a big (40%!)
-- benefit from let newDest = ... in case (notSeen newDest) of ...
-- We want to inline notSeen. The argument has structure (its RHS)
- -- and in fact if we inline notSeen, newDest turns into a thunk
+ -- and in fact if we inline notSeen, newDest stops being a thunk
-- (SPJ GHC log 13 Nov).
- | Just rhs <- expandUnfolding_maybe unfolding
- = go (zapSubstEnv env) rhs val_args
-
| OtherCon cs <- unfolding
= ArgIsNot cs
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -206,7 +206,7 @@ defaultUnfoldingOpts = UnfoldingOpts
-- inline into Csg.calc (The unfolding for sqr never makes it
-- into the interface file.)
- , unfoldingUseThreshold = 70
+ , unfoldingUseThreshold = 75
-- Adjusted 90 -> 80 when adding discounts for free variables which
-- generally make things more likely to inline. Reducing the threshold
-- eliminates some undesirable compile-time regressions (e.g. T10412a)
@@ -214,7 +214,7 @@ defaultUnfoldingOpts = UnfoldingOpts
-- Previously: adjusted upwards in #18282, when I reduced
-- the result discount for constructors.
- , unfoldingFunAppDiscount = 30
+ , unfoldingFunAppDiscount = 45
-- Be fairly keen to inline a function if that means
-- we'll be able to pick the right method from a dictionary
@@ -913,7 +913,7 @@ caseSize scrut_id alts
caseElimDiscount :: Discount
-- Bonus for eliminating a case
-caseElimDiscount = 10
+caseElimDiscount = 15
{- Note [Bale out on very wide case expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1220,8 +1220,6 @@ binary sizes shrink significantly either.
data InlineContext
= IC { ic_free :: Id -> ArgDigest -- Current unfoldings for free variables
, ic_bound :: IdEnv ArgDigest -- Digests for local variables
- , ic_want_res :: Bool -- True <=> result is scrutinised/demanded
- -- so apply result discount
}
data ArgDigest
@@ -1254,15 +1252,8 @@ exprTreeWillInline limit (ExprTree { et_wc_tot = tot }) = tot <= limit
-------------------------
exprTreeSize :: InlineContext -> ExprTree -> Size
-- See Note [Overview of inlining heuristics]
-exprTreeSize !ic (ExprTree { et_size = size
- , et_cases = cases
- , et_ret = ret_discount })
- = foldr ((+) . caseTreeSize (ic { ic_want_res = False }))
- -- False: all result discount is at the top; ignore inner ones
- discounted_size cases
- where
- discounted_size | ic_want_res ic = size - ret_discount
- | otherwise = size
+exprTreeSize !ic (ExprTree { et_size = size, et_cases = cases })
+ = foldr ((+) . caseTreeSize ic) size cases
caseTreeSize :: InlineContext -> CaseTree -> Size
caseTreeSize ic (ScrutOf bndr disc)
=====================================
libraries/ghc-prim/GHC/Classes.hs
=====================================
@@ -146,8 +146,10 @@ class Eq a where
{-# INLINE (/=) #-}
{-# INLINE (==) #-}
- x /= y = not (x == y)
- x == y = not (x /= y)
+ -- Write these with no arg, so that they inline even as the argument of
+ -- the DFun. Then the RULES for eqList can fire.
+ (/=) = \x y -> not (x == y)
+ (==) = \x y -> not (x /= y)
{-# MINIMAL (==) | (/=) #-}
deriving instance Eq ()
@@ -189,9 +191,22 @@ instance (Eq a) => Eq [a] where
{-# SPECIALISE instance Eq [[Char]] #-}
{-# SPECIALISE instance Eq [Char] #-}
{-# SPECIALISE instance Eq [Int] #-}
- [] == [] = True
- (x:xs) == (y:ys) = x == y && xs == ys
- _xs == _ys = False
+ (==) = eqList
+
+-- These rules avoid the recursive function when
+-- one of the arguments is the empty list. We want
+-- good code for xs == [] or xs /= []
+{-# RULES
+"eqList1" forall xs. eqList xs [] = case xs of { [] -> True; _ -> False }
+"eqList2" forall ys. eqList [] ys = case ys of { [] -> True; _ -> False }
+ #-}
+
+eqList :: Eq a => [a] -> [a] -> Bool
+{-# NOINLINE [1] eqList #-} -- Give the RULES eqList1/eqList2 a chance to fire
+-- eqList should auto-specialise for the same types as specialise instance Eq above
+eqList [] [] = True
+eqList (x:xs) (y:ys) = x == y && eqList xs ys
+eqList _xs _ys = False
deriving instance Eq Module
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ddd17134826249bbe87c370dbcabb12fc7a6c5d9...6b3918cc8a9e37c7ef97c49d5279acf72f9e2685
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ddd17134826249bbe87c370dbcabb12fc7a6c5d9...6b3918cc8a9e37c7ef97c49d5279acf72f9e2685
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/20231121/fb47199f/attachment-0001.html>
More information about the ghc-commits
mailing list