addSpecInfo, addIdSpecialisations )
import PprCore ( pprCoreBindings, pprCoreExpr, pprRules )
import OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
-import IdInfo ( setNewStrictnessInfo, newStrictnessInfo,
- setUnfoldingInfo, unfoldingInfo, setSpecInfoHead,
- setInlinePragInfo, inlinePragInfo,
- setSpecInfo, specInfo, specInfoRules )
+import IdInfo
import CoreUtils ( coreBindsSize )
import Simplify ( simplTopBinds, simplExpr )
import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
import FamInstEnv
import Id
import DataCon
-import TyCon ( tyConSelIds, tyConDataCons )
+import TyCon ( tyConDataCons )
import Class ( classSelIds )
-import BasicTypes ( CompilerPhase, isActive )
+import BasicTypes ( CompilerPhase, isActive, isDefaultInlinePragma )
import VarSet
import VarEnv
import NameEnv ( lookupNameEnv )
ModGuts) -- Modified fields are
-- (a) Bindings have rules attached,
- -- and INLINE rules simplified
-- (b) Rules are now just orphan rules
prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
guts@(ModGuts { mg_binds = binds, mg_deps = deps
, mg_rules = local_rules, mg_rdr_env = rdr_env })
us
- = do { us <- mkSplitUniqSupply 'w'
-
- ; let -- Simplify the local rules; boringly, we need to make an in-scope set
+ = do { let -- Simplify the local rules; boringly, we need to make an in-scope set
-- from the local binders, to avoid warnings from Simplify.simplVar
local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
env = setInScopeSet gentleSimplEnv local_ids
- (simpl_rules, _) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
- mapM (simplRule env) local_rules
-
- ; let (rules_for_locals, rules_for_imps) = partition isLocalRule simpl_rules
-
- home_pkg_rules = hptRules hsc_env (dep_mods deps)
- hpt_rule_base = mkRuleBase home_pkg_rules
- imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
-
- binds_w_rules = updateBinders rules_for_locals binds
-
+ (better_rules,_) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
+ (mapM (simplRule env) local_rules)
+ home_pkg_rules = hptRules hsc_env (dep_mods deps)
+
+ -- Find the rules for locally-defined Ids; then we can attach them
+ -- to the binders in the top-level bindings
+ --
+ -- Reason
+ -- - It makes the rules easier to look up
+ -- - It means that transformation rules and specialisations for
+ -- locally defined Ids are handled uniformly
+ -- - It keeps alive things that are referred to only from a rule
+ -- (the occurrence analyser knows about rules attached to Ids)
+ -- - It makes sure that, when we apply a rule, the free vars
+ -- of the RHS are more likely to be in scope
+ -- - The imported rules are carried in the in-scope set
+ -- which is extended on each iteration by the new wave of
+ -- local binders; any rules which aren't on the binding will
+ -- thereby get dropped
+ (rules_for_locals, rules_for_imps) = partition isLocalRule better_rules
+ local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
+ binds_w_rules = updateBinders local_rule_base binds
+
+ hpt_rule_base = mkRuleBase home_pkg_rules
+ imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
; Err.dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
(withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $
- vcat [text "Local rules", pprRules simpl_rules,
+ vcat [text "Local rules", pprRules better_rules,
text "",
text "Imported rules", pprRuleBase imp_rule_base])
mg_rules = rules_for_imps })
}
--- Note [Attach rules to local ids]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Find the rules for locally-defined Ids; then we can attach them
--- to the binders in the top-level bindings
---
--- Reason
--- - It makes the rules easier to look up
--- - It means that transformation rules and specialisations for
--- locally defined Ids are handled uniformly
--- - It keeps alive things that are referred to only from a rule
--- (the occurrence analyser knows about rules attached to Ids)
--- - It makes sure that, when we apply a rule, the free vars
--- of the RHS are more likely to be in scope
--- - The imported rules are carried in the in-scope set
--- which is extended on each iteration by the new wave of
--- local binders; any rules which aren't on the binding will
--- thereby get dropped
-
-updateBinders :: [CoreRule] -> [CoreBind] -> [CoreBind]
-updateBinders rules_for_locals binds
- = map update_bind binds
+updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
+updateBinders local_rules binds
+ = map update_bndrs binds
where
- local_rules = extendRuleBaseList emptyRuleBase rules_for_locals
-
- update_bind (NonRec b r) = NonRec (add_rules b) r
- update_bind (Rec prs) = Rec (mapFst add_rules prs)
-
- -- See Note [Attach rules to local ids]
- -- NB: the binder might have some existing rules,
- -- arising from specialisation pragmas
- add_rules bndr
- | Just rules <- lookupNameEnv local_rules (idName bndr)
- = bndr `addIdSpecialisations` rules
- | otherwise
- = bndr
+ update_bndrs (NonRec b r) = NonRec (update_bndr b) r
+ update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
+
+ update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of
+ Nothing -> bndr
+ Just rules -> bndr `addIdSpecialisations` rules
+ -- The binder might have some existing rules,
+ -- arising from specialisation pragmas
\end{code}
Note [Simplifying the left-hand side of a RULE]
otherwise we don't match when given an argument like
augment (\a. h a a) (build h)
-The simplifier does indeed do eta reduction (it's in
-Simplify.completeLam) but only if -O is on.
-
\begin{code}
simplRule env rule@(BuiltinRule {})
= return rule
args' <- mapM (simplExprGently env) args
rhs' <- simplExprGently env rhs
return (rule { ru_bndrs = bndrs', ru_args = args', ru_rhs = rhs' })
+
+-- It's important that simplExprGently does eta reduction.
+-- For example, in a rule like:
+-- augment g (build h)
+-- we do not want to get
+-- augment (\a. g a) (build h)
+-- otherwise we don't match when given an argument like
+-- (\a. h a a)
+--
+-- The simplifier does indeed do eta reduction (it's in
+-- Simplify.completeLam) but only if -O is on.
\end{code}
\begin{code}
makes strictness information propagate better. This used to happen in
the final phase, but it's tidier to do it here.
+Note [Transferring IdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to propagage any useful IdInfo on x_local to x_exported.
+
STRICTNESS: if we have done strictness analysis, we want the strictness info on
x_local to transfer to x_exported. Hence the copyIdInfo call.
RULES: we want to *add* any RULES for x_local to x_exported.
-Note [Rules and indirection-zapping]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Problem: what if x_exported has a RULE that mentions something in ...bindings...?
-Then the things mentioned can be out of scope! Solution
- a) Make sure that in this pass the usage-info from x_exported is
- available for ...bindings...
- b) If there are any such RULES, rec-ify the entire top-level.
- It'll get sorted out next time round
-Messing up the rules
-~~~~~~~~~~~~~~~~~~~~
+Note [Messing up the exported Id's IdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must be careful about discarding the IdInfo on the old Id
+
The example that went bad on me at one stage was this one:
iterate :: (a -> a) -> a -> [a]
-> iterateFB (:) f x
-> iterate f x
-Tiresome old solution:
- don't do shorting out if f has rewrite rules (see shortableIdInfo)
-
-New solution (I think):
+Old "solution":
use rule switching-off pragmas to get rid
of iterateList in the first place
+But in principle the user *might* want rules that only apply to the Id
+he says. And inline pragmas are similar
+ {-# NOINLINE f #-}
+ f = local
+ local = <stuff>
+Then we do not want to get rid of the NOINLINE.
+
+Hence hasShortableIdinfo.
+
+
+Note [Rules and indirection-zapping]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Problem: what if x_exported has a RULE that mentions something in ...bindings...?
+Then the things mentioned can be out of scope! Solution
+ a) Make sure that in this pass the usage-info from x_exported is
+ available for ...bindings...
+ b) If there are any such RULES, rec-ify the entire top-level.
+ It'll get sorted out next time round
Other remarks
~~~~~~~~~~~~~
add_pair (exported_id, rhs) env
= env
+-----------------
shortMeOut ind_env exported_id local_id
-- The if-then-else stuff is just so I can get a pprTrace to see
-- how often I don't get shorting out becuase of IdInfo stuff
not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for
then
- True
-
-{- No longer needed
- if isEmptySpecInfo (specInfo (idInfo exported_id)) -- Only if no rules
- then True -- See note on "Messing up rules"
- else
-#ifdef DEBUG
- pprTrace "shortMeOut:" (ppr exported_id)
-#endif
- False
--}
+ if hasShortableIdInfo exported_id
+ then True -- See Note [Messing up the exported Id's IdInfo]
+ else WARN( True, ptext (sLit "Not shorting out:") <+> ppr exported_id )
+ False
else
- False
+ False
+-----------------
+hasShortableIdInfo :: Id -> Bool
+-- True if there is no user-attached IdInfo on exported_id,
+-- so we can safely discard it
+-- See Note [Messing up the exported Id's IdInfo]
+hasShortableIdInfo id
+ = isEmptySpecInfo (specInfo info)
+ && isDefaultInlinePragma (inlinePragInfo info)
+ where
+ info = idInfo id
-----------------
transferIdInfo :: Id -> Id -> Id
+-- See Note [Transferring IdInfo]
-- If we have
-- lcl_id = e; exp_id = lcl_id
-- and lcl_id has useful IdInfo, we don't want to discard it by going
where
local_info = idInfo local_id
transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
- `setUnfoldingInfo` unfoldingInfo local_info
+ `setWorkerInfo` workerInfo local_info
`setInlinePragInfo` inlinePragInfo local_info
`setSpecInfo` addSpecInfo (specInfo exp_info) new_info
new_info = setSpecInfoHead (idName exported_id)
projects / ghc-hetmet.git / blobdiff