mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
- getRules,
+ getSimplRules,
SimplSR(..), mkContEx, substId, lookupRecBndr,
-- Why delete? Consider
-- let x = a*b in (x, \x -> x+3)
-- We add [x |-> a*b] to the substitution, but we must
- -- *delete* it from the substitution when going inside
+ -- _delete_ it from the substitution when going inside
-- the (\x -> ...)!
-modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
-modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
- = env {seInScope = modifyInScopeSet in_scope v v'}
+modifyInScope :: SimplEnv -> CoreBndr -> SimplEnv
+-- The variable should already be in scope, but
+-- replace the existing version with this new one
+-- which has more information
+modifyInScope env@(SimplEnv {seInScope = in_scope}) v
+ = env {seInScope = extendInScopeSet in_scope v}
---------------------
zapSubstEnv :: SimplEnv -> SimplEnv
mkContEx :: SimplEnv -> InExpr -> SimplSR
mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
-
-isEmptySimplSubst :: SimplEnv -> Bool
-isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
- = isEmptyVarEnv tvs && isEmptyVarEnv ids
\end{code}
doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
= not (isNilOL fs) && want_to_float && can_float
where
- want_to_float = isTopLevel lvl || exprIsCheap rhs
+ want_to_float = isTopLevel lvl || exprIsExpandable rhs
can_float = case ff of
FltLifted -> True
FltOkSpec -> isNotTopLevel lvl && isNonRec rec
%* *
%************************************************************************
+Note [Global Ids in the substitution]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We look up even a global (eg imported) Id in the substitution. Consider
+ case X.g_34 of b { (a,b) -> ... case X.g_34 of { (p,q) -> ...} ... }
+The binder-swap in the occurence analyser will add a binding
+for a LocalId version of g (with the same unique though):
+ case X.g_34 of b { (a,b) -> let g_34 = b in
+ ... case X.g_34 of { (p,q) -> ...} ... }
+So we want to look up the inner X.g_34 in the substitution, where we'll
+find that it has been substituted by b. (Or conceivably cloned.)
\begin{code}
substId :: SimplEnv -> InId -> SimplSR
-- Returns DoneEx only on a non-Var expression
substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
- | not (isLocalId v)
- = DoneId v
- | otherwise -- A local Id
- = case lookupVarEnv ids v of
+ = case lookupVarEnv ids v of -- Note [Global Ids in the substitution]
Nothing -> DoneId (refine in_scope v)
Just (DoneId v) -> DoneId (refine in_scope v)
- Just (DoneEx (Var v))
- | isLocalId v -> DoneId (refine in_scope v)
- | otherwise -> DoneId v
+ Just (DoneEx (Var v)) -> DoneId (refine in_scope v)
Just res -> res -- DoneEx non-var, or ContEx
where
-- Even though it isn't in the substitution, it may be in
-- the in-scope set with better IdInfo
refine :: InScopeSet -> Var -> Var
-refine in_scope v = case lookupInScope in_scope v of
+refine in_scope v
+ | isLocalId v = case lookupInScope in_scope v of
Just v' -> v'
Nothing -> WARN( True, ppr v ) v -- This is an error!
+ | otherwise = v
lookupRecBndr :: SimplEnv -> InId -> OutId
-- Look up an Id which has been put into the envt by simplRecBndrs,
old_unf = idUnfolding bndr
(env1, id1) = substIdBndr env bndr
id2 = id1 `setIdUnfolding` substUnfolding env old_unf
- env2 = modifyInScope env1 id1 id2
+ env2 = modifyInScope env1 id2
---------------
simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
\begin{code}
addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
--- Rules are added back in to to hte bin
+-- Rules are added back in to to the bin
addBndrRules env in_id out_id
| isEmptySpecInfo old_rules = (env, out_id)
- | otherwise = (modifyInScope env out_id final_id, final_id)
+ | otherwise = (modifyInScope env final_id, final_id)
where
subst = mkCoreSubst env
old_rules = idSpecialisation in_id
substUnfolding _ NoUnfolding = NoUnfolding
substUnfolding _ (OtherCon cons) = OtherCon cons
substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
-substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
+substUnfolding env (CoreUnfolding rhs t u v w g) = CoreUnfolding (substExpr env rhs) t u v w g
------------------
substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
substExpr :: SimplEnv -> CoreExpr -> CoreExpr
-substExpr env expr
- | isEmptySimplSubst env = expr
- | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr
+substExpr env expr = CoreSubst.substExpr (mkCoreSubst env) expr
+ -- Do *not* short-cut in the case of an empty substitution
+ -- See CoreSubst: Note [Extending the Subst]
\end{code}