[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