getEnclosingCC, setEnclosingCC,
-- Environments
- SimplEnv, emptySimplEnv, getSubst, setSubst,
- getSubstEnv, extendSubst, extendSubstList,
- getInScope, setInScope, modifyInScope, addNewInScopeIds,
- setSubstEnv, zapSubstEnv,
+ SimplEnv, emptySimplEnv, getSubst, setSubst, extendIdSubst, extendTvSubst,
+ zapSubstEnv, setSubstEnv, getTvSubst, setTvSubstEnv,
+ getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
-- Floats
Floats, emptyFloats, isEmptyFloats, unitFloat, addFloats, flattenFloats,
import CostCentre ( CostCentreStack, subsumedCCS )
import Var
import VarEnv
-import VarSet
import OrdList
import qualified Subst
-import Subst ( Subst, mkSubst, substEnv,
- InScopeSet, mkInScopeSet, substInScope,
- isInScope
- )
-import Type ( Type, isUnLiftedType )
+import Subst ( Subst, SubstResult, emptySubst, substInScope, isInScope )
+import Type ( Type, TvSubst, TvSubstEnv, isUnLiftedType )
import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
UniqSupply
)
)
import CmdLineOpts ( SimplifierSwitch(..), SimplifierMode(..),
DynFlags, DynFlag(..), dopt,
- opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining,
+ opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining, opt_RulesOff
)
import Unique ( Unique )
import Outputable
unitFloat :: SimplEnv -> OutId -> OutExpr -> Floats
-- A single non-rec float; extend the in-scope set
unitFloat env var rhs = Floats (unitOL (NonRec var rhs))
- (Subst.extendInScopeSet (getInScope env) var)
+ (extendInScopeSet (getInScope env) var)
(not (isUnLiftedType (idType var)))
addFloats :: SimplEnv -> Floats
-- have a correctly-substituted type. So we use a lookup in this
-- set to replace occurrences
-emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> VarSet -> SimplEnv
-emptySimplEnv mode switches in_scope
- = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS, seMode = mode,
- seSubst = mkSubst (mkInScopeSet in_scope) emptySubstEnv }
+emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> SimplEnv
+emptySimplEnv mode switches
+ = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS,
+ seMode = mode, seSubst = emptySubst }
-- The top level "enclosing CC" is "SUBSUMED".
---------------------
getSubst :: SimplEnv -> Subst
getSubst env = seSubst env
+getTvSubst :: SimplEnv -> TvSubst
+getTvSubst env = Subst.getTvSubst (seSubst env)
+
+setTvSubstEnv :: SimplEnv -> TvSubstEnv -> SimplEnv
+setTvSubstEnv env@(SimplEnv {seSubst = subst}) tv_subst_env
+ = env {seSubst = Subst.setTvSubstEnv subst tv_subst_env}
+
setSubst :: SimplEnv -> Subst -> SimplEnv
setSubst env subst = env {seSubst = subst}
-extendSubst :: SimplEnv -> CoreBndr -> SubstResult -> SimplEnv
-extendSubst env@(SimplEnv {seSubst = subst}) var res
- = env {seSubst = Subst.extendSubst subst var res}
+extendIdSubst :: SimplEnv -> Id -> SubstResult -> SimplEnv
+extendIdSubst env@(SimplEnv {seSubst = subst}) var res
+ = env {seSubst = Subst.extendIdSubst subst var res}
-extendSubstList :: SimplEnv -> [CoreBndr] -> [SubstResult] -> SimplEnv
-extendSubstList env@(SimplEnv {seSubst = subst}) vars ress
- = env {seSubst = Subst.extendSubstList subst vars ress}
+extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
+extendTvSubst env@(SimplEnv {seSubst = subst}) var res
+ = env {seSubst = Subst.extendTvSubst subst var res}
---------------------
getInScope :: SimplEnv -> InScopeSet
setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
setInScopeSet env@(SimplEnv {seSubst = subst}) in_scope
- = env {seSubst = Subst.setInScope subst in_scope}
+ = env {seSubst = Subst.setInScopeSet subst in_scope}
addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
-- The new Ids are guaranteed to be freshly allocated
addNewInScopeIds env@(SimplEnv {seSubst = subst}) vs
- = env {seSubst = Subst.extendNewInScopeList subst vs}
+ = env {seSubst = Subst.extendInScopeIds subst vs}
modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
modifyInScope env@(SimplEnv {seSubst = subst}) v v'
= env {seSubst = Subst.modifyInScope subst v v'}
---------------------
-getSubstEnv :: SimplEnv -> SubstEnv
-getSubstEnv env = substEnv (seSubst env)
-
-setSubstEnv :: SimplEnv -> SubstEnv -> SimplEnv
-setSubstEnv env@(SimplEnv {seSubst = subst}) senv
- = env {seSubst = Subst.setSubstEnv subst senv}
-
zapSubstEnv :: SimplEnv -> SimplEnv
zapSubstEnv env@(SimplEnv {seSubst = subst})
= env {seSubst = Subst.zapSubstEnv subst}
+
+setSubstEnv :: SimplEnv -> Subst -> SimplEnv
+setSubstEnv env@(SimplEnv {seSubst = subst}) subst_with_env
+ = env {seSubst = Subst.setSubstEnv subst subst_with_env}
\end{code}
SimplGently -> isAlwaysActive prag
SimplPhase n -> isActive n prag
prag = idInlinePragma bndr
-\end{code}
-
-blackListInline tells if we must not inline at a call site because the
-Id's inline pragma says not to do so.
-
-However, blackListInline is ignored for things with with Compulsory inlinings,
-because they don't have bindings, so we must inline them no matter how
-gentle we are being.
-\begin{code}
activeInline :: SimplEnv -> OutId -> OccInfo -> Bool
activeInline env id occ
= case getMode env of
- SimplGently -> isAlwaysActive prag && isOneOcc occ
+ SimplGently -> isOneOcc occ && isAlwaysActive prag
-- No inlining at all when doing gentle stuff,
- -- except for things that occur once
+ -- except for local things that occur once
-- The reason is that too little clean-up happens if you
-- don't inline use-once things. Also a bit of inlining is *good* for
-- full laziness; it can expose constant sub-expressions.
activeRule :: SimplEnv -> Maybe (Activation -> Bool)
-- Nothing => No rules at all
activeRule env
+ | opt_RulesOff = Nothing
+ | otherwise
= case getMode env of
- SimplGently -> Nothing -- No rules in gentle mode
+ SimplGently -> Just isAlwaysActive
+ -- Used to be Nothing (no rules in gentle mode)
+ -- Main motivation for changing is that I wanted
+ -- lift String ===> ...
+ -- to work in Template Haskell when simplifying
+ -- splices, so we get simpler code for literal strings
SimplPhase n -> Just (isActive n)
\end{code}