diff options
Diffstat (limited to 'compiler/specialise')
| -rw-r--r-- | compiler/specialise/Rules.hs | 29 | ||||
| -rw-r--r-- | compiler/specialise/SpecConstr.hs | 20 | ||||
| -rw-r--r-- | compiler/specialise/Specialise.hs | 22 |
3 files changed, 45 insertions, 26 deletions
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index dd48832864..9b5d3cf763 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -16,8 +16,8 @@ module Rules ( -- ** Checking rule applications ruleCheckProgram, - -- ** Manipulating 'SpecInfo' rules - mkSpecInfo, extendSpecInfo, addSpecInfo, + -- ** Manipulating 'RuleInfo' rules + mkRuleInfo, extendRuleInfo, addRuleInfo, addIdSpecialisations, -- * Misc. CoreRule helpers @@ -43,7 +43,7 @@ import TysPrim ( anyTypeOfKind ) import Coercion import CoreTidy ( tidyRules ) import Id -import IdInfo ( SpecInfo( SpecInfo ) ) +import IdInfo ( RuleInfo( RuleInfo ) ) import Var import VarEnv import VarSet @@ -180,7 +180,6 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs -- A rule is an orphan only if none of the variables -- mentioned on its left-hand side are locally defined lhs_names = nameSetElems (extendNameSet (exprsOrphNames args) fn) - -- TODO: copied from ruleLhsOrphNames -- Since rules get eventually attached to one of the free names -- from the definition when compiling the ABI hash, we should make @@ -268,30 +267,30 @@ pprRulesForUser rules {- ************************************************************************ * * - SpecInfo: the rules in an IdInfo + RuleInfo: the rules in an IdInfo * * ************************************************************************ -} --- | Make a 'SpecInfo' containing a number of 'CoreRule's, suitable +-- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable -- for putting into an 'IdInfo' -mkSpecInfo :: [CoreRule] -> SpecInfo -mkSpecInfo rules = SpecInfo rules (rulesFreeVars rules) +mkRuleInfo :: [CoreRule] -> RuleInfo +mkRuleInfo rules = RuleInfo rules (rulesFreeVars rules) -extendSpecInfo :: SpecInfo -> [CoreRule] -> SpecInfo -extendSpecInfo (SpecInfo rs1 fvs1) rs2 - = SpecInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1) +extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo +extendRuleInfo (RuleInfo rs1 fvs1) rs2 + = RuleInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1) -addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo -addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2) - = SpecInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2) +addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo +addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2) + = RuleInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2) addIdSpecialisations :: Id -> [CoreRule] -> Id addIdSpecialisations id [] = id addIdSpecialisations id rules = setIdSpecialisation id $ - extendSpecInfo (idSpecialisation id) rules + extendRuleInfo (idSpecialisation id) rules -- | Gather all the rules for locally bound identifiers from the supplied bindings rulesOfBinds :: [CoreBind] -> [CoreRule] diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 5435920e5c..cb3830bb6b 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -1246,7 +1246,7 @@ scExpr' env (Let (NonRec bndr rhs) body) ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] - mkLets [NonRec b r | (b,r) <- specInfoBinds rhs_info specs] body') + mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body') } @@ -1269,7 +1269,7 @@ scExpr' env (Let (Rec prs) body) -- See Note [Local recursive groups] ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] - bind' = Rec (concat (zipWith specInfoBinds rhs_infos specs)) + bind' = Rec (concat (zipWith ruleInfoBinds rhs_infos specs)) ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, Let bind' body') } @@ -1379,7 +1379,7 @@ scTopBind env body_usage (Rec prs) body_usage rhs_infos ; return (body_usage `combineUsage` spec_usage, - Rec (concat (zipWith specInfoBinds rhs_infos specs))) } + Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) } where (bndrs,rhss) = unzip prs force_spec = any (forceSpecBndr env) bndrs @@ -1406,8 +1406,8 @@ scRecRhs env (bndr,rhs) -- Two pats are the same if they match both ways ---------------------- -specInfoBinds :: RhsInfo -> [OneSpec] -> [(Id,CoreExpr)] -specInfoBinds (RI { ri_fn = fn, ri_new_rhs = new_rhs }) specs +ruleInfoBinds :: RhsInfo -> [OneSpec] -> [(Id,CoreExpr)] +ruleInfoBinds (RI { ri_fn = fn, ri_new_rhs = new_rhs }) specs = [(id,rhs) | OS _ _ id rhs <- specs] ++ -- First the specialised bindings @@ -1434,7 +1434,7 @@ data RhsInfo , ri_arg_occs :: [ArgOcc] -- Info on how the xs occur in body } -data SpecInfo = SI [OneSpec] -- The specialisations we have generated +data RuleInfo = SI [OneSpec] -- The specialisations we have generated Int -- Length of specs; used for numbering them @@ -1505,13 +1505,13 @@ specialise :: ScEnv -> CallEnv -- Info on newly-discovered calls to this function -> RhsInfo - -> SpecInfo -- Original RHS plus patterns dealt with - -> UniqSM (ScUsage, SpecInfo) -- New specialised versions and their usage + -> RuleInfo -- Original RHS plus patterns dealt with + -> UniqSM (ScUsage, RuleInfo) -- New specialised versions and their usage -- See Note [spec_usg includes rhs_usg] -- Note: this only generates *specialised* bindings --- The original binding is added by specInfoBinds +-- The original binding is added by ruleInfoBinds -- -- Note: the rhs here is the optimised version of the original rhs -- So when we make a specialised copy of the RHS, we're starting @@ -1692,7 +1692,7 @@ calcSpecStrictness fn qvars pats Note [spec_usg includes rhs_usg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In calls to 'specialise', the returned ScUsage must include the rhs_usg in -the passed-in SpecInfo, unless there are no calls at all to the function. +the passed-in RuleInfo, unless there are no calls at all to the function. The caller can, indeed must, assume this. He should not combine in rhs_usg himself, or he'll get rhs_usg twice -- and that can lead to an exponential diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index e3501dfd38..008561c4b3 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -449,7 +449,7 @@ The SpecEnv of an Id maps a list of types (the template) to an expression [Type] |-> Expr -For example, if f has this SpecInfo: +For example, if f has this RuleInfo: [Int, a] -> \d:Ord Int. f' a @@ -1324,6 +1324,26 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs ; return (Just ((spec_f_w_arity, spec_rhs), final_uds, spec_env_rule)) } } +{- +Note [Orphans and auto-generated rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we specialise an INLINEABLE function, or when we have +-fspecialise-aggressively, we auto-generate RULES that are orphans. +We don't want to warn about these, or we'd generate a lot of warnings. +Thus, we only warn about user-specified orphan rules. + +Indeed, we don't even treat the module as an orphan module if it has +auto-generated *rule* orphans. Orphan modules are read every time we +compile, so they are pretty obtrusive and slow down every compilation, +even non-optimised ones. (Reason: for type class instances it's a +type correctness issue.) But specialisation rules are strictly for +*optimisation* only so it's fine not to read the interface. + +What this means is that a SPEC rules from auto-specialisation in +module M will be used in other modules only if M.hi has been read for +some other reason, which is actually pretty likely. +-} + bindAuxiliaryDicts :: SpecEnv -> [DictId] -> [CoreExpr] -- Original dict bndrs, and the witnessing expressions |