cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
-- ** Simple expression optimiser
- simpleOptPgm, simpleOptExpr
+ simpleOptPgm, simpleOptExpr, simpleOptExprWith
) where
#include "HsVersions.h"
In consequence:
-* In substIdBndr, we extend the IdSubstEnv only when the unique changes
+* If the TvSubstEnv and IdSubstEnv are both empty, substExpr would be a
+ no-op, so substExprSC ("short cut") does nothing.
+
+ However, substExpr still goes ahead and substitutes. Reason: we may
+ want to replace existing Ids with new ones from the in-scope set, to
+ avoid space leaks.
-* If the TvSubstEnv and IdSubstEnv are both empty, substExpr does nothing
- (Note that the above rule for substIdBndr maintains this property. If
- the incoming envts are both empty, then substituting the type and
- IdInfo can't change anything.)
+* In substIdBndr, we extend the IdSubstEnv only when the unique changes
* In lookupIdSubst, we *must* look up the Id in the in-scope set, because
it may contain non-trivial changes. Example:
set when we find the occurrence of x.
* The requirement to look up the Id in the in-scope set means that we
- must NOT take no-op short cut in the case the substitution is empty.
+ must NOT take no-op short cut when the IdSubst is empty.
We must still look up every Id in the in-scope set.
* (However, we don't need to do so for expressions found in the IdSubst
go (Lit lit) = Lit lit
go (App fun arg) = App (go fun) (go arg)
go (Note note e) = Note (go_note note) (go e)
- go (Cast e co)
- | isIdentityCoercion co' = go e
- | otherwise = Cast (go e) co'
- where
- co' = optCoercion (getTvSubst subst) co
- -- Optimise coercions as we go; this is good, for example
- -- in the RHS of rules, which are only substituted in
+ go (Cast e co) = Cast (go e) (optCoercion (getTvSubst subst) co)
+ -- Do not optimise even identity coercions
+ -- Reason: substitution applies to the LHS of RULES, and
+ -- if you "optimise" an identity coercion, you may
+ -- lose a binder. We optimise the LHS of rules at
+ -- construction time
go (Lam bndr body) = Lam bndr' (subst_expr subst' body)
where
then subst_ru_fn fn_name
else fn_name,
ru_args = map (substExpr (text "subst-rule" <+> ppr fn_name) subst') args,
- ru_rhs = substExpr (text "subst-rule" <+> ppr fn_name) subst' rhs }
+ ru_rhs = simpleOptExprWith subst' rhs }
+ -- Do simple optimisation on RHS, in case substitution lets
+ -- you improve it. The real simplifier never gets to look at it.
where
(subst', bndrs') = substBndrs subst bndrs
simpleOptExpr expr
= -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)
- simple_opt_expr init_subst (occurAnalyseExpr expr)
+ simpleOptExprWith init_subst expr
where
init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
-- It's potentially important to make a proper in-scope set
-- It's a bit painful to call exprFreeVars, because it makes
-- three passes instead of two (occ-anal, and go)
+simpleOptExprWith :: Subst -> InExpr -> OutExpr
+simpleOptExprWith subst expr = simple_opt_expr subst (occurAnalyseExpr expr)
+
----------------------
simpleOptPgm :: DynFlags -> [CoreBind] -> [CoreRule] -> IO ([CoreBind], [CoreRule])
simpleOptPgm dflags binds rules
; return (reverse binds', substRulesForImportedIds subst' rules) }
where
- occ_anald_binds = occurAnalysePgm binds rules
+ occ_anald_binds = occurAnalysePgm Nothing {- No rules active -}
+ rules binds
(subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds
do_one (subst, binds') bind