diff options
author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-10-10 14:34:21 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-10-10 15:41:05 +0200 |
commit | 840df33685e8c746ade4b9d4d0eb7c764a773e48 (patch) | |
tree | 3f9f176e79b384f01190d6b5c0027a3b44744aa0 /compiler | |
parent | 182c44da50db028a432a81789048c87922bd30f4 (diff) | |
download | haskell-840df33685e8c746ade4b9d4d0eb7c764a773e48.tar.gz |
Rename SpecInfo to RuleInfo (upon SPJ's advice).
Test Plan: validate
Reviewers: simonpj, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1319
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/basicTypes/Id.hs | 12 | ||||
-rw-r--r-- | compiler/basicTypes/IdInfo.hs | 56 | ||||
-rw-r--r-- | compiler/basicTypes/MkId.hs | 6 | ||||
-rw-r--r-- | compiler/coreSyn/CoreFVs.hs | 2 | ||||
-rw-r--r-- | compiler/coreSyn/CorePrep.hs | 2 | ||||
-rw-r--r-- | compiler/coreSyn/CoreSeq.hs | 8 | ||||
-rw-r--r-- | compiler/coreSyn/CoreSubst.hs | 14 | ||||
-rw-r--r-- | compiler/coreSyn/PprCore.hs | 2 | ||||
-rw-r--r-- | compiler/main/TidyPgm.hs | 2 | ||||
-rw-r--r-- | compiler/simplCore/OccurAnal.hs | 2 | ||||
-rw-r--r-- | compiler/simplCore/SetLevels.hs | 2 | ||||
-rw-r--r-- | compiler/simplCore/SimplCore.hs | 12 | ||||
-rw-r--r-- | compiler/simplCore/Simplify.hs | 6 | ||||
-rw-r--r-- | compiler/specialise/Rules.hs | 28 | ||||
-rw-r--r-- | compiler/specialise/SpecConstr.hs | 20 | ||||
-rw-r--r-- | compiler/specialise/Specialise.hs | 2 |
16 files changed, 88 insertions, 88 deletions
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 45a4aa75b3..5e38e302f8 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -573,17 +573,17 @@ setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id -- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs -idSpecialisation :: Id -> SpecInfo -idSpecialisation id = specInfo (idInfo id) +idSpecialisation :: Id -> RuleInfo +idSpecialisation id = ruleInfo (idInfo id) idCoreRules :: Id -> [CoreRule] -idCoreRules id = specInfoRules (idSpecialisation id) +idCoreRules id = ruleInfoRules (idSpecialisation id) idHasRules :: Id -> Bool -idHasRules id = not (isEmptySpecInfo (idSpecialisation id)) +idHasRules id = not (isEmptyRuleInfo (idSpecialisation id)) -setIdSpecialisation :: Id -> SpecInfo -> Id -setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id +setIdSpecialisation :: Id -> RuleInfo -> Id +setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id --------------------------------- -- CAF INFO diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 02910051a2..d8d0e7fcad 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -51,12 +51,12 @@ module IdInfo ( InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, - -- ** The SpecInfo type - SpecInfo(..), - emptySpecInfo, - isEmptySpecInfo, specInfoFreeVars, - specInfoRules, setSpecInfoHead, - specInfo, setSpecInfo, + -- ** The RuleInfo type + RuleInfo(..), + emptyRuleInfo, + isEmptyRuleInfo, ruleInfoFreeVars, + ruleInfoRules, setRuleInfoHead, + ruleInfo, setRuleInfo, -- ** The CAFInfo type CafInfo(..), @@ -83,7 +83,7 @@ import FastString import Demand -- infixl so you can say (id `set` a `set` b) -infixl 1 `setSpecInfo`, +infixl 1 `setRuleInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, @@ -195,7 +195,7 @@ pprIdDetails other = brackets (pp other) data IdInfo = IdInfo { arityInfo :: !ArityInfo, -- ^ 'Id' arity - specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist + ruleInfo :: RuleInfo, -- ^ Specialisations of the 'Id's function which exist -- See Note [Specialisations and RULES in IdInfo] unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding cafInfo :: CafInfo, -- ^ 'Id' CAF info @@ -212,8 +212,8 @@ data IdInfo -- Setters -setSpecInfo :: IdInfo -> SpecInfo -> IdInfo -setSpecInfo info sp = sp `seq` info { specInfo = sp } +setRuleInfo :: IdInfo -> RuleInfo -> IdInfo +setRuleInfo info sp = sp `seq` info { ruleInfo = sp } setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo :: IdInfo -> OccInfo -> IdInfo @@ -255,7 +255,7 @@ vanillaIdInfo = IdInfo { cafInfo = vanillaCafInfo, arityInfo = unknownArity, - specInfo = emptySpecInfo, + ruleInfo = emptyRuleInfo, unfoldingInfo = noUnfolding, oneShotInfo = NoOneShotInfo, inlinePragInfo = defaultInlinePragma, @@ -333,13 +333,13 @@ pprStrictness sig = ppr sig {- ************************************************************************ * * - SpecInfo + RuleInfo * * ************************************************************************ Note [Specialisations and RULES in IdInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Generally speaking, a GlobalIdshas an *empty* SpecInfo. All their +Generally speaking, a GlobalIdshas an *empty* RuleInfo. All their RULES are contained in the globally-built rule-base. In principle, one could attach the to M.f the RULES for M.f that are defined in M. But we don't do that for instance declarations and so we just treat @@ -348,7 +348,7 @@ them all uniformly. The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is jsut for convenience really. -However, LocalIds may have non-empty SpecInfo. We treat them +However, LocalIds may have non-empty RuleInfo. We treat them differently because: a) they might be nested, in which case a global table won't work b) the RULE might mention free variables, which we use to keep things alive @@ -359,8 +359,8 @@ and put in the global list. -- | Records the specializations of this 'Id' that we know about -- in the form of rewrite 'CoreRule's that target them -data SpecInfo - = SpecInfo +data RuleInfo + = RuleInfo [CoreRule] VarSet -- Locally-defined free vars of *both* LHS and RHS -- of rules. I don't think it needs to include the @@ -368,24 +368,24 @@ data SpecInfo -- Note [Rule dependency info] in OccurAnal -- | Assume that no specilizations exist: always safe -emptySpecInfo :: SpecInfo -emptySpecInfo = SpecInfo [] emptyVarSet +emptyRuleInfo :: RuleInfo +emptyRuleInfo = RuleInfo [] emptyVarSet -isEmptySpecInfo :: SpecInfo -> Bool -isEmptySpecInfo (SpecInfo rs _) = null rs +isEmptyRuleInfo :: RuleInfo -> Bool +isEmptyRuleInfo (RuleInfo rs _) = null rs -- | Retrieve the locally-defined free variables of both the left and -- right hand sides of the specialization rules -specInfoFreeVars :: SpecInfo -> VarSet -specInfoFreeVars (SpecInfo _ fvs) = fvs +ruleInfoFreeVars :: RuleInfo -> VarSet +ruleInfoFreeVars (RuleInfo _ fvs) = fvs -specInfoRules :: SpecInfo -> [CoreRule] -specInfoRules (SpecInfo rules _) = rules +ruleInfoRules :: RuleInfo -> [CoreRule] +ruleInfoRules (RuleInfo rules _) = rules -- | Change the name of the function the rule is keyed on on all of the 'CoreRule's -setSpecInfoHead :: Name -> SpecInfo -> SpecInfo -setSpecInfoHead fn (SpecInfo rules fvs) - = SpecInfo (map (setRuleIdName fn) rules) fvs +setRuleInfoHead :: Name -> RuleInfo -> RuleInfo +setRuleInfoHead fn (RuleInfo rules fvs) + = RuleInfo (map (setRuleIdName fn) rules) fvs {- ************************************************************************ @@ -467,7 +467,7 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) zapFragileInfo :: IdInfo -> Maybe IdInfo -- ^ Zap info that depends on free variables zapFragileInfo info - = Just (info `setSpecInfo` emptySpecInfo + = Just (info `setRuleInfo` emptyRuleInfo `setUnfoldingInfo` noUnfolding `setOccInfo` zapFragileOcc occ) where diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 6f812def6b..0fa0005462 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -295,7 +295,7 @@ mkDictSelId name clas -- for why alwaysInlinePragma | otherwise - = base_info `setSpecInfo` mkSpecInfo [rule] + = base_info `setRuleInfo` mkRuleInfo [rule] -- Add a magic BuiltinRule, but no unfolding -- so that the rule is always available to fire. -- See Note [ClassOp/DFun selection] in TcInstDcls @@ -952,7 +952,7 @@ mkPrimOpId prim_op id = mkGlobalId (PrimOpId prim_op) name ty info info = noCafIdInfo - `setSpecInfo` mkSpecInfo (maybeToList $ primOpRules name prim_op) + `setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op) `setArityInfo` arity `setStrictnessInfo` strict_sig `setInlinePragInfo` neverInlinePragma @@ -1125,7 +1125,7 @@ seqId = pcMiscPrelId seqName ty info where info = noCafIdInfo `setInlinePragInfo` inline_prag `setUnfoldingInfo` mkCompulsoryUnfolding rhs - `setSpecInfo` mkSpecInfo [seq_cast_rule] + `setRuleInfo` mkRuleInfo [seq_cast_rule] inline_prag = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0 -- Make 'seq' not inline-always, so that simpleOptExpr diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index af4197ea84..0e5027768a 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -408,7 +408,7 @@ idRuleAndUnfoldingVars id = ASSERT( isId id) idUnfoldingVars id idRuleVars ::Id -> VarSet -- Does *not* include CoreUnfolding vars -idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id) +idRuleVars id = ASSERT( isId id) ruleInfoFreeVars (idSpecialisation id) idUnfoldingVars :: Id -> VarSet -- Produce free vars for an unfolding, but NOT for an ordinary diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 7b256a4012..d8fd59e43e 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1218,7 +1218,7 @@ cpCloneBndr env bndr -- so that we can drop more stuff as dead code. -- See also Note [Dead code in CorePrep] let bndr'' = bndr' `setIdUnfolding` noUnfolding - `setIdSpecialisation` emptySpecInfo + `setIdSpecialisation` emptyRuleInfo return (extendCorePrepEnv env bndr bndr'', bndr'') | otherwise -- Top level things, which we don't want diff --git a/compiler/coreSyn/CoreSeq.hs b/compiler/coreSyn/CoreSeq.hs index 9bd3f458b6..e3c7844f2e 100644 --- a/compiler/coreSyn/CoreSeq.hs +++ b/compiler/coreSyn/CoreSeq.hs @@ -7,7 +7,7 @@ module CoreSeq ( -- * Utilities for forcing Core structures seqExpr, seqExprs, seqUnfolding, seqRules, - megaSeqIdInfo, seqSpecInfo, seqBinds, + megaSeqIdInfo, seqRuleInfo, seqBinds, ) where import CoreSyn @@ -24,7 +24,7 @@ import Id( Id, idInfo ) -- compiler megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqSpecInfo (specInfo info) `seq` + = seqRuleInfo (ruleInfo info) `seq` -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all @@ -39,8 +39,8 @@ megaSeqIdInfo info seqOneShot :: OneShotInfo -> () seqOneShot l = l `seq` () -seqSpecInfo :: SpecInfo -> () -seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs +seqRuleInfo :: RuleInfo -> () +seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqVarSet fvs seqCaf :: CafInfo -> () seqCaf c = c `seq` () diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index e78ff70888..c1de2051ee 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -623,12 +623,12 @@ substIdType subst@(Subst _ _ tv_env cv_env) id substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo substIdInfo subst new_id info | nothing_to_do = Nothing - | otherwise = Just (info `setSpecInfo` substSpec subst new_id old_rules + | otherwise = Just (info `setRuleInfo` substSpec subst new_id old_rules `setUnfoldingInfo` substUnfolding subst old_unf) where - old_rules = specInfo info + old_rules = ruleInfo info old_unf = unfoldingInfo info - nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf + nothing_to_do = isEmptyRuleInfo old_rules && isClosedUnfolding old_unf ------------------ @@ -668,12 +668,12 @@ substIdOcc subst v = case lookupIdSubst (text "substIdOcc") subst v of ------------------ -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id' -substSpec :: Subst -> Id -> SpecInfo -> SpecInfo -substSpec subst new_id (SpecInfo rules rhs_fvs) - = seqSpecInfo new_spec `seq` new_spec +substSpec :: Subst -> Id -> RuleInfo -> RuleInfo +substSpec subst new_id (RuleInfo rules rhs_fvs) + = seqRuleInfo new_spec `seq` new_spec where subst_ru_fn = const (idName new_id) - new_spec = SpecInfo (map (substRule subst subst_ru_fn) rules) + new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules) (substVarSet subst rhs_fvs) ------------------ diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 2ae1577bd0..eb5e595925 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -418,7 +418,7 @@ ppIdInfo id info unf_info = unfoldingInfo info has_unf = hasSomeUnfolding unf_info - rules = specInfoRules (specInfo info) + rules = ruleInfoRules (ruleInfo info) showAttributes :: [(Bool,SDoc)] -> SDoc showAttributes stuff diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index 2b31a03b21..efc6148b5a 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -832,7 +832,7 @@ dffvLetBndr :: Bool -> Id -> DFFV () -- we say "True" if we are exposing that unfolding dffvLetBndr vanilla_unfold id = do { go_unf (unfoldingInfo idinfo) - ; mapM_ go_rule (specInfoRules (specInfo idinfo)) } + ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) } where idinfo = idInfo id diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 1e086027ba..1e485aee1e 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -253,7 +253,7 @@ always in scope. * Note [Rule dependency info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The VarSet in a SpecInfo is used for dependency analysis in the + The VarSet in a RuleInfo is used for dependency analysis in the occurrence analyser. We must track free vars in *both* lhs and rhs. Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind. Why both? Consider diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index de02e27c2b..d873cc5e15 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -1015,7 +1015,7 @@ abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs -- We are going to lambda-abstract, so nuke any IdInfo, -- and add the tyvars of the Id (if necessary) zap v | isId v = WARN( isStableUnfolding (idUnfolding v) || - not (isEmptySpecInfo (idSpecialisation v)), + not (isEmptyRuleInfo (idSpecialisation v)), text "absVarsOf: discarding info on" <+> ppr v ) setIdInfo v vanillaIdInfo | otherwise = v diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 90233d608a..dddb24d335 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -15,7 +15,7 @@ import CoreSyn import HscTypes import CSE ( cseProgram ) import Rules ( mkRuleBase, unionRuleBase, - extendRuleBaseList, ruleCheckProgram, addSpecInfo, ) + extendRuleBaseList, ruleCheckProgram, addRuleInfo, ) import PprCore ( pprCoreBindings, pprCoreExpr ) import OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) import IdInfo @@ -871,7 +871,7 @@ shortOutIndirections binds -- These exported Ids are the subjects of the indirection-elimination exp_ids = map fst $ varEnvElts ind_env exp_id_set = mkVarSet exp_ids - no_need_to_flatten = all (null . specInfoRules . idSpecialisation) exp_ids + no_need_to_flatten = all (null . ruleInfoRules . idSpecialisation) exp_ids binds' = concatMap zap binds zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)] @@ -929,7 +929,7 @@ hasShortableIdInfo :: Id -> Bool -- so we can safely discard it -- See Note [Messing up the exported Id's IdInfo] hasShortableIdInfo id - = isEmptySpecInfo (specInfo info) + = isEmptyRuleInfo (ruleInfo info) && isDefaultInlinePragma (inlinePragInfo info) && not (isStableUnfolding (unfoldingInfo info)) where @@ -951,8 +951,8 @@ transferIdInfo exported_id local_id transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info `setUnfoldingInfo` unfoldingInfo local_info `setInlinePragInfo` inlinePragInfo local_info - `setSpecInfo` addSpecInfo (specInfo exp_info) new_info - new_info = setSpecInfoHead (idName exported_id) - (specInfo local_info) + `setRuleInfo` addRuleInfo (ruleInfo exp_info) new_info + new_info = setRuleInfoHead (idName exported_id) + (ruleInfo local_info) -- Remember to set the function-name field of the -- rules as we transfer them from one function to another diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 07bc0041a1..320ea9f8dd 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -36,7 +36,7 @@ import CoreUnfold import CoreUtils import CoreArity --import PrimOp ( tagToEnumKey ) -- temporalily commented out. See #8326 -import Rules ( mkSpecInfo, lookupRule, getRules ) +import Rules ( mkRuleInfo, lookupRule, getRules ) import TysPrim ( voidPrimTy ) --, intPrimTy ) -- temporalily commented out. See #8326 import BasicTypes ( TopLevelFlag(..), isTopLevel, RecFlag(..) ) import MonadUtils ( foldlM, mapAccumLM, liftIO ) @@ -2957,10 +2957,10 @@ addBndrRules env in_id out_id = return (env, out_id) | otherwise = do { new_rules <- simplRules env (Just (idName out_id)) old_rules - ; let final_id = out_id `setIdSpecialisation` mkSpecInfo new_rules + ; let final_id = out_id `setIdSpecialisation` mkRuleInfo new_rules ; return (modifyInScope env final_id, final_id) } where - old_rules = specInfoRules (idSpecialisation in_id) + old_rules = ruleInfoRules (idSpecialisation in_id) simplRules :: SimplEnv -> Maybe Name -> [CoreRule] -> SimplM [CoreRule] simplRules env mb_new_nm rules diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index d6a56d6fe4..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 @@ -267,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 8e76492cc5..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 |