InCoercion, OutCoercion,
-- The simplifier mode
- setMode, getMode,
+ setMode, getMode, updMode,
-- Switch checker
SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
setEnclosingCC, getEnclosingCC,
-- Environments
- SimplEnv(..), pprSimplEnv, -- Temp not abstract
+ SimplEnv(..), StaticEnv, pprSimplEnv, -- Temp not abstract
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, substWorker, substTy,
+ substExpr, substTy, mkCoreSubst,
-- Floats
Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
import VarSet
import OrdList
import Id
-import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
+import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substUnfolding )
import qualified Type ( substTy, substTyVarBndr )
import Type hiding ( substTy, substTyVarBndr )
import Coercion
\begin{code}
data SimplEnv
= SimplEnv {
+ ----------- Static part of the environment -----------
+ -- Static in the sense of lexically scoped,
+ -- wrt the original expression
+
seMode :: SimplifierMode,
seChkr :: SwitchChecker,
seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
+ -- The current substitution
+ seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
+ seIdSubst :: SimplIdSubst, -- InId |--> OutExpr
+
+ ----------- Dynamic part of the environment -----------
+ -- Dynamic in the sense of describing the setup where
+ -- the expression finally ends up
+
-- The current set of in-scope variables
-- They are all OutVars, and all bound in this module
seInScope :: InScopeSet, -- OutVars only
-- Includes all variables bound by seFloats
- seFloats :: Floats,
+ seFloats :: Floats
-- See Note [Simplifier floats]
-
- -- The current substitution
- seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
- seIdSubst :: SimplIdSubst -- InId |--> OutExpr
-
}
+type StaticEnv = SimplEnv -- Just the static part is relevant
+
pprSimplEnv :: SimplEnv -> SDoc
-- Used for debugging; selective
pprSimplEnv env
\begin{code}
-mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
-mkSimplEnv mode switches
+mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
+mkSimplEnv switches mode
= SimplEnv { seChkr = switches, seCC = subsumedCCS,
seMode = mode, seInScope = emptyInScopeSet,
seFloats = emptyFloats,
setMode :: SimplifierMode -> SimplEnv -> SimplEnv
setMode mode env = env { seMode = mode }
+updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
+updMode upd env = env { seMode = upd (seMode env) }
+
+inGentleMode :: SimplEnv -> Bool
+inGentleMode env = case seMode env of
+ SimplGently {} -> True
+ _other -> False
+
---------------------
getEnclosingCC :: SimplEnv -> CostCentreStack
getEnclosingCC env = seCC env
old_rules = idSpecialisation in_id
new_rules = CoreSubst.substSpec subst out_id old_rules
final_id = out_id `setIdSpecialisation` new_rules
-
-------------------
-substIdType :: SimplEnv -> Id -> Id
-substIdType (SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
- | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
- | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
- -- The tyVarsOfType is cheaper than it looks
- -- because we cache the free tyvars of the type
- -- in a Note in the id's type itself
- where
- old_ty = idType id
-
-------------------
-substUnfolding :: SimplEnv -> Unfolding -> Unfolding
-substUnfolding _ NoUnfolding = NoUnfolding
-substUnfolding _ (OtherCon cons) = OtherCon cons
-substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
-substUnfolding env (CoreUnfolding rhs t u v w g) = CoreUnfolding (substExpr env rhs) t u v w g
-
-------------------
-substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
-substWorker _ NoWorker = NoWorker
-substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
\end{code}
fiddle (DoneId v) = Var v
fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
+------------------
+substIdType :: SimplEnv -> Id -> Id
+substIdType (SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
+ | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
+ | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
+ -- The tyVarsOfType is cheaper than it looks
+ -- because we cache the free tyvars of the type
+ -- in a Note in the id's type itself
+ where
+ old_ty = idType id
+
+------------------
substExpr :: SimplEnv -> CoreExpr -> CoreExpr
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]
+
+substUnfolding :: SimplEnv -> Unfolding -> Unfolding
+substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst env) unf
\end{code}