import PprCore ( pprCoreBindings, pprCoreExpr, pprRules )
import OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
import IdInfo ( setNewStrictnessInfo, newStrictnessInfo,
- setWorkerInfo, workerInfo, setSpecInfoHead,
+ setUnfoldingInfo, unfoldingInfo, setSpecInfoHead,
setInlinePragInfo, inlinePragInfo,
setSpecInfo, specInfo, specInfoRules )
import CoreUtils ( coreBindsSize )
-- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which
-- would mean our cached value would go out of date.
let mod = mg_module guts
- (guts, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do
+ (guts2, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do
-- FIND BUILT-IN PASSES
let builtin_core_todos = getCoreToDo dflags
- -- Note [Injecting implicit bindings]
- let implicit_binds = getImplicitBinds (mg_types guts1)
- guts2 = guts1 { mg_binds = implicit_binds ++ mg_binds guts1 }
-
-- DO THE BUSINESS
- doCorePasses builtin_core_todos guts2
+ doCorePasses builtin_core_todos guts1
Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
"Grand total simplifier statistics"
(pprSimplCount stats)
- return guts
+ return guts2
type CorePass = CoreToDo
%************************************************************************
%* *
- Implicit bindings
-%* *
-%************************************************************************
-
-Note [Injecting implicit bindings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We used to inject the implict bindings right at the end, in CoreTidy.
-But some of these bindings, notably record selectors, are not
-constructed in an optimised form. E.g. record selector for
- data T = MkT { x :: {-# UNPACK #-} !Int }
-Then the unfolding looks like
- x = \t. case t of MkT x1 -> let x = I# x1 in x
-This generates bad code unless it's first simplified a bit.
-(Only matters when the selector is used curried; eg map x ys.)
-See Trac #2070.
-
-\begin{code}
-getImplicitBinds :: TypeEnv -> [CoreBind]
-getImplicitBinds type_env
- = map get_defn (concatMap implicit_con_ids (typeEnvTyCons type_env)
- ++ concatMap other_implicit_ids (typeEnvElts type_env))
- -- Put the constructor wrappers first, because
- -- other implicit bindings (notably the fromT functions arising
- -- from generics) use the constructor wrappers. At least that's
- -- what External Core likes
- where
- implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
-
- other_implicit_ids (ATyCon tc) = filter (not . isNaughtyRecordSelector) (tyConSelIds tc)
- -- The "naughty" ones are not real functions at all
- -- They are there just so we can get decent error messages
- -- See Note [Naughty record selectors] in MkId.lhs
- other_implicit_ids (AClass cl) = classSelIds cl
- other_implicit_ids _other = []
-
- get_defn :: Id -> CoreBind
- get_defn id = NonRec id (unfoldingTemplate (idUnfolding id))
-\end{code}
-
-
-%************************************************************************
-%* *
Dealing with rules
%* *
%************************************************************************
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 { let -- Simplify the local rules; boringly, we need to make an in-scope set
+ = do { us <- mkSplitUniqSupply 'w'
+
+ ; 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
- (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
+ (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
+
; Err.dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
(withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $
- vcat [text "Local rules", pprRules better_rules,
+ vcat [text "Local rules", pprRules simpl_rules,
text "",
text "Imported rules", pprRuleBase imp_rule_base])
mg_rules = rules_for_imps })
}
-updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
-updateBinders local_rules binds
- = map update_bndrs binds
+-- 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
where
- 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
+ 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
\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}
where
local_info = idInfo local_id
transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
- `setWorkerInfo` workerInfo local_info
+ `setUnfoldingInfo` unfoldingInfo local_info
`setInlinePragInfo` inlinePragInfo local_info
`setSpecInfo` addSpecInfo (specInfo exp_info) new_info
new_info = setSpecInfoHead (idName exported_id)
projects / ghc-hetmet.git / blobdiff