[Git][ghc/ghc][wip/andreask/inlineable-threshold] Add a RuleSource type. Refactor w/w actication logic slightly.
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Fri Dec 30 00:07:44 UTC 2022
Andreas Klebinger pushed to branch wip/andreask/inlineable-threshold at Glasgow Haskell Compiler / GHC
Commits:
c97caa50 by Andreas Klebinger at 2022-12-30T01:06:13+01:00
Add a RuleSource type. Refactor w/w actication logic slightly.
I found it hard to remember if True means auto rule or non-auto rule
when reading the code so I made that it's own type.
Also factored out the logic to determine inline phase for W/W as I plan
to reuse that code for specialisation rule activations.
Some more stuff
- - - - -
10 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Types/Basic.hs
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -1134,7 +1134,8 @@ data CoreRule
-- See Note [OccInfo in unfoldings and rules]
-- Locality
- ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
+ ru_auto :: RuleSource,
+ -- ^ @True@ <=> this rule is auto-generated
-- (notably by Specialise or SpecConstr)
-- @False@ <=> generated at the user's behest
-- See Note [Trimming auto-rules] in "GHC.Iface.Tidy"
@@ -1187,7 +1188,10 @@ isBuiltinRule _ = False
isAutoRule :: CoreRule -> Bool
isAutoRule (BuiltinRule {}) = False
-isAutoRule (Rule { ru_auto = is_auto }) = is_auto
+isAutoRule (Rule { ru_auto = is_auto }) =
+ case is_auto of
+ RuleSrcAuto -> True
+ RuleSrcUser -> False
-- | The number of arguments the 'ru_fn' must be applied
-- to before the rule can match on it
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -1960,7 +1960,7 @@ spec_one env fn arg_bndrs body (call_pat, rule_number)
dropTail (length extra_bndrs) spec_call_args
inline_act = idInlineActivation fn
this_mod = sc_module $ sc_opts env
- rule = mkRule this_mod True {- Auto -} True {- Local -}
+ rule = mkRule this_mod RuleSrcAuto {- Auto -} True {- Local -}
rule_name inline_act
fn_name qvars' pats' rule_rhs
-- See Note [Transfer activation]
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1597,7 +1597,8 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules
specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
-- The first case is the interesting one
| notNull calls_for_me -- And there are some calls to specialise
- && not (isNeverActive (idInlineActivation fn))
+ , not (isNeverActive inl_act)
+ || isStableUserUnfolding fn_unf
-- Don't specialise NOINLINE things
-- See Note [Auto-specialisation and RULES]
--
@@ -1605,6 +1606,9 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
-- Since OPAQUE things are always never-active (see
-- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for
-- OPAQUE things.
+ --
+ -- We make an exception if the user wrote an explicit INLINEABLE pragma
+ -- which is indicated by `isStableUserUnfolding`
-- && not (certainlyWillInline (idUnfolding fn)) -- And it's not small
-- See Note [Inline specialisations] for why we do not
@@ -1729,7 +1733,16 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
| otherwise = -- Specialising local fn
text "SPEC"
- spec_rule = mkSpecRule dflags this_mod True inl_act
+ spec_act = activeAfter rule_phase
+ where
+ existing_rules = idCoreRules fn
+ -- It's okay if the specialization conflicts with other specialisations
+ user_rules = filter (not . isAutoRule) existing_rules
+ inline_phase = beginPhase inl_act
+ rule_phase = inline_phase `afterRules` user_rules
+
+
+ spec_rule = mkSpecRule dflags this_mod RuleSrcAuto spec_act
herald fn rule_bndrs rule_lhs_args
(mkVarApps (Var spec_fn) spec_bndrs)
@@ -2278,6 +2291,8 @@ that g doesn't inline too early.
This in turn means that the RULE would never fire for a NOINLINE
thing so not much point in generating a specialisation at all.
+Similar
+
Note [Specialisation shape]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
We only specialise a function if it has visible top-level lambdas
=====================================
compiler/GHC/Core/Opt/WorkWrap.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Core.Utils ( exprType, exprIsHNF )
import GHC.Core.Type
import GHC.Core.Opt.WorkWrap.Utils
import GHC.Core.SimpleOpt
+import GHC.Core.Rules
import GHC.Types.Var
import GHC.Types.Id
@@ -901,17 +902,13 @@ mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
, inl_rule = rule_info } -- RuleMatchInfo is (and must be) unaffected
where
-- See Note [Wrapper activation]
- wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_inline_phase rules
+ wrapper_phase = earliest_inline_phase `afterRules` rules
earliest_inline_phase = beginPhase fn_act `laterPhase` nextPhase InitialPhase
-- laterPhase (nextPhase InitialPhase) is a temporary hack
-- to inline no earlier than phase 2. I got regressions in
-- 'mate', due to changes in full laziness due to Note [Case
-- MFEs], when I did earlier inlining.
- get_rule_phase :: CoreRule -> CompilerPhase
- -- The phase /after/ the rule is first active
- get_rule_phase rule = nextPhase (beginPhase (ruleActivation rule))
-
{-
Note [Demand on the worker]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -30,7 +30,10 @@ module GHC.Core.Rules (
rulesOfBinds, getRules, pprRulesForUser,
-- * Making rules
- mkRule, mkSpecRule, roughTopNames
+ mkRule, mkSpecRule, roughTopNames,
+
+ -- * Dealing with when rules fire
+ afterRules
) where
@@ -182,7 +185,19 @@ to apply the specialised function to, are handled by the fact that the
Rule contains a template for the result of the specialisation.
-}
-mkRule :: Module -> Bool -> Bool -> RuleName -> Activation
+-- Sometimes we want to push some activation back such that it fires after a
+-- given set of activations.
+afterRules :: CompilerPhase -> [CoreRule] -> CompilerPhase
+afterRules earliest_phase rules
+ = wrapper_phase
+ where
+ wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_phase rules
+
+ get_rule_phase :: CoreRule -> CompilerPhase
+ -- The phase /after/ the rule is first active
+ get_rule_phase rule = nextPhase (beginPhase (ruleActivation rule))
+
+mkRule :: Module -> RuleSource -> Bool -> RuleName -> Activation
-> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
-- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
-- compiled. See also 'GHC.Core.CoreRule'
@@ -208,7 +223,7 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs
orph = chooseOrphanAnchor local_lhs_names
--------------
-mkSpecRule :: DynFlags -> Module -> Bool -> Activation -> SDoc
+mkSpecRule :: DynFlags -> Module -> RuleSource -> Activation -> SDoc
-> Id -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
-- Make a specialisation rule, for Specialise or SpecConstr
mkSpecRule dflags this_mod is_auto inl_act herald fn bndrs args rhs
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -476,7 +476,7 @@ dsRule (L loc (HsRule { rd_name = name
simpl_opts = initSimpleOpts dflags
final_rhs = simpleOptExpr simpl_opts rhs'' -- De-crap it
rule_name = unLoc name
- rule = mkRule this_mod False is_local rule_name rule_act
+ rule = mkRule this_mod RuleSrcUser is_local rule_name rule_act
fn_name final_bndrs args final_rhs
; dsWarnOrphanRule rule
; dsWarnRuleShadowing fn_id rule
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -718,7 +718,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
`setInlinePragma` inl_prag
`setIdUnfolding` spec_unf
- rule = mkSpecRule dflags this_mod False rule_act (text "USPEC")
+ rule = mkSpecRule dflags this_mod RuleSrcUser rule_act (text "USPEC")
poly_id rule_bndrs rule_lhs_args
(mkVarApps (Var spec_id) spec_bndrs)
spec_rhs = mkLams spec_bndrs (core_app poly_rhs)
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -53,6 +53,7 @@ import GHC.Utils.Logger
import GHC.Utils.Constants (debugIsOn)
import GHC.Types.Annotations
+import GHC.Types.Basic (RuleSource(..))
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
@@ -1257,7 +1258,7 @@ addFingerprints hsc_env iface0
, mi_opt_hash = opt_hash
, mi_hpc_hash = hpc_hash
, mi_plugin_hash = plugin_hash
- , mi_orphan = not ( all ifRuleAuto orph_rules
+ , mi_orphan = not ( all (is_if_auto_rule . ifRuleAuto) orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
&& null orph_fis)
@@ -1280,6 +1281,9 @@ addFingerprints hsc_env iface0
(non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
(non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
ann_fn = mkIfaceAnnCache (mi_anns iface0)
+ is_if_auto_rule src = case src of
+ RuleSrcAuto -> True
+ RuleSrcUser -> False
-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
-- (in particular, the orphan modules which are transitively imported by the
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -319,7 +319,7 @@ data IfaceRule
ifRuleHead :: IfExtName, -- Head of lhs
ifRuleArgs :: [IfaceExpr], -- Args of LHS
ifRuleRhs :: IfaceExpr,
- ifRuleAuto :: Bool,
+ ifRuleAuto :: RuleSource,
ifRuleOrph :: IsOrphan -- Just like IfaceClsInst
}
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -83,6 +83,7 @@ module GHC.Types.Basic (
isNeverActive, isAlwaysActive, activeInFinalPhase,
activateAfterInitial, activateDuringFinal, activeAfter,
+ RuleSource(..),
RuleMatchInfo(..), isConLike, isFunLike,
InlineSpec(..), noUserInlineSpec,
InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
@@ -124,11 +125,12 @@ import GHC.Utils.Panic
import GHC.Utils.Binary
import GHC.Types.SourceText
import qualified GHC.LanguageExtensions as LangExt
-import Data.Data
-import qualified Data.Semigroup as Semi
import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
+import Data.Data
+import qualified Data.Semigroup as Semi
+import Control.DeepSeq
{- *********************************************************************
* *
Binary choice
@@ -452,6 +454,27 @@ type RuleName = FastString
pprRuleName :: RuleName -> SDoc
pprRuleName rn = doubleQuotes (ftext rn)
+data RuleSource
+ = RuleSrcUser -- ^ User written rule
+ | RuleSrcAuto -- ^ Rule generated by GHC. Currently only SpecConstr or Specialise.
+ deriving (Eq,Ord,Data)
+
+instance Binary RuleSource where
+ put_ bh RuleSrcUser = putByte bh 0
+ put_ bh RuleSrcAuto = putByte bh 1
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return RuleSrcUser
+ 1 -> return RuleSrcAuto
+ _ -> panic "Binary:RuleSource - invalid byte"
+
+instance Outputable RuleSource where
+ ppr RuleSrcUser = text "User"
+ ppr RuleSrcAuto = text "Auto"
+
+instance NFData RuleSource where
+ rnf !_ = ()
{-
************************************************************************
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c97caa50494d4bf1661ea153d0d58863735ef69a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c97caa50494d4bf1661ea153d0d58863735ef69a
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/20221229/e0309d95/attachment-0001.html>
More information about the ghc-commits
mailing list