mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
- getSimplRules,
+ getSimplRules, inGentleMode,
SimplSR(..), mkContEx, substId, lookupRecBndr,
simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
simplBinder, simplBinders, addBndrRules,
- substExpr, substTy, substUnfolding,
+ substExpr, substTy, mkCoreSubst,
-- Floats
Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
setMode :: SimplifierMode -> SimplEnv -> SimplEnv
setMode mode env = env { seMode = mode }
+inGentleMode :: SimplEnv -> Bool
+inGentleMode env = case seMode env of
+ SimplGently -> True
+ _other -> False
+
---------------------
getEnclosingCC :: SimplEnv -> CostCentreStack
getEnclosingCC env = seCC env
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
where
old_unf = idUnfolding bndr
(env1, id1) = substIdBndr env bndr
- id2 = id1 `setIdUnfolding` substUnfolding env False old_unf
+ id2 = id1 `setIdUnfolding` substUnfolding env old_unf
env2 = modifyInScope env1 id2
---------------
-- Do *not* short-cut in the case of an empty substitution
-- See CoreSubst: Note [Extending the Subst]
-substUnfolding :: SimplEnv -> Bool -> Unfolding -> Unfolding
-substUnfolding env is_top_lvl unf
- | InlineRule {} <- unf' = unf' { uf_is_top = is_top_lvl }
- | otherwise = unf'
- where
- unf' = CoreSubst.substUnfolding (mkCoreSubst env) unf
+substUnfolding :: SimplEnv -> Unfolding -> Unfolding
+substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst env) unf
\end{code}