Commit c177e43f authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Refactoring of the way that inlinings and rules are activated

Principally, the SimplifierMode now carries several (currently
four) flags in *all* phases, not just the "Gentle" phase.
This makes things simpler and more uniform.

As usual I did more refactoring than I had intended.

This stuff should go into 7.0.2 in due course, once
we've checked it solves the DPH performance problems.
parent a0f04208
......@@ -59,8 +59,9 @@ module BasicTypes(
DefMethSpec(..),
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
CompilerPhase(..), PhaseNum,
Activation(..), isActive, isActiveIn,
isNeverActive, isAlwaysActive, isEarlyActive,
RuleMatchInfo(..), isConLike, isFunLike,
InlineSpec(..),
InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
......@@ -637,14 +638,22 @@ failed Failed = True
When a rule or inlining is active
\begin{code}
type CompilerPhase = Int -- Compilation phase
-- Phases decrease towards zero
-- Zero is the last phase
type PhaseNum = Int -- Compilation phase
-- Phases decrease towards zero
-- Zero is the last phase
data CompilerPhase
= Phase PhaseNum
| InitialPhase -- The first phase -- number = infinity!
instance Outputable CompilerPhase where
ppr (Phase n) = int n
ppr InitialPhase = ptext (sLit "InitialPhase")
data Activation = NeverActive
| AlwaysActive
| ActiveBefore CompilerPhase -- Active only *before* this phase
| ActiveAfter CompilerPhase -- Active in this phase and later
| ActiveBefore PhaseNum -- Active only *before* this phase
| ActiveAfter PhaseNum -- Active in this phase and later
deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
......@@ -830,10 +839,16 @@ instance Outputable InlinePragma where
| otherwise = ppr info
isActive :: CompilerPhase -> Activation -> Bool
isActive _ NeverActive = False
isActive _ AlwaysActive = True
isActive p (ActiveAfter n) = p <= n
isActive p (ActiveBefore n) = p > n
isActive InitialPhase AlwaysActive = True
isActive InitialPhase (ActiveBefore {}) = True
isActive InitialPhase _ = False
isActive (Phase p) act = isActiveIn p act
isActiveIn :: PhaseNum -> Activation -> Bool
isActiveIn _ NeverActive = False
isActiveIn _ AlwaysActive = True
isActiveIn p (ActiveAfter n) = p <= n
isActiveIn p (ActiveBefore n) = p > n
isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
isNeverActive NeverActive = True
......
......@@ -300,6 +300,7 @@ mkDataConIds wrap_name wkr_name data_con
`setArityInfo` wrap_arity
-- It's important to specify the arity, so that partial
-- applications are treated as values
`setInlinePragInfo` alwaysInlinePragma
`setUnfoldingInfo` wrap_unf
`setStrictnessInfo` Just wrap_sig
......
......@@ -49,7 +49,7 @@ module CoreSyn (
maybeUnfoldingTemplate, otherCons, unfoldingArity,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
isStableUnfolding, isStableUnfolding_maybe,
isStableUnfolding, isStableCoreUnfolding_maybe,
isClosedUnfolding, hasSomeUnfolding,
canUnfold, neverUnfoldGuidance, isStableSource,
......@@ -70,7 +70,7 @@ module CoreSyn (
RuleName, IdUnfoldingFun,
-- ** Operations on 'CoreRule's
seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
setRuleIdName,
isBuiltinRule, isLocalRule
) where
......@@ -384,9 +384,9 @@ ruleArity (Rule {ru_args = args}) = length args
ruleName :: CoreRule -> RuleName
ruleName = ru_name
ruleActivation_maybe :: CoreRule -> Maybe Activation
ruleActivation_maybe (BuiltinRule { }) = Nothing
ruleActivation_maybe (Rule { ru_act = act }) = Just act
ruleActivation :: CoreRule -> Activation
ruleActivation (BuiltinRule { }) = AlwaysActive
ruleActivation (Rule { ru_act = act }) = act
-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
ruleIdName :: CoreRule -> Name
......@@ -669,15 +669,10 @@ expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
expandUnfolding_maybe _ = Nothing
isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
| isStableSource src
= Just (src, unsat_ok)
where
unsat_ok = case guide of
UnfWhen unsat_ok _ -> unsat_ok
_ -> needSaturated
isStableUnfolding_maybe _ = Nothing
isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
| isStableSource src = Just src
isStableCoreUnfolding_maybe _ = Nothing
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
......
......@@ -730,13 +730,12 @@ StrictAnal.addStrictnessInfoToTopId
\begin{code}
callSiteInline :: DynFlags
-> Id -- The Id
-> Unfolding -- Its unfolding (if active)
-> Bool -- True <=> unfolding is active
-> Bool -- True if there are are no arguments at all (incl type args)
-> [ArgSummary] -- One for each value arg; True if it is interesting
-> CallCtxt -- True <=> continuation is interesting
-> Maybe CoreExpr -- Unfolding, if any
instance Outputable ArgSummary where
ppr TrivArg = ptext (sLit "TrivArg")
ppr NonTrivArg = ptext (sLit "NonTrivArg")
......@@ -765,67 +764,32 @@ instance Outputable CallCtxt where
ppr CaseCtxt = ptext (sLit "CaseCtxt")
ppr ValAppCtxt = ptext (sLit "ValAppCtxt")
callSiteInline dflags id unfolding lone_variable arg_infos cont_info
= case unfolding of {
NoUnfolding -> Nothing ;
OtherCon _ -> Nothing ;
DFunUnfolding {} -> Nothing ; -- Never unfold a DFun
CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top,
uf_is_cheap = is_cheap, uf_arity = uf_arity, uf_guidance = guidance } ->
callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info
= case idUnfolding id of
-- idUnfolding checks for loop-breakers, returning NoUnfolding
-- Things with an INLINE pragma may have an unfolding *and*
-- be a loop breaker (maybe the knot is not yet untied)
CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top
, uf_is_cheap = is_cheap, uf_arity = uf_arity
, uf_guidance = guidance }
| active_unfolding -> tryUnfolding dflags id lone_variable
arg_infos cont_info unf_template is_top
is_cheap uf_arity guidance
| otherwise -> Nothing
NoUnfolding -> Nothing
OtherCon {} -> Nothing
DFunUnfolding {} -> Nothing -- Never unfold a DFun
tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt
-> CoreExpr -> Bool -> Bool -> Arity -> UnfoldingGuidance
-> Maybe CoreExpr
tryUnfolding dflags id lone_variable
arg_infos cont_info unf_template is_top
is_cheap uf_arity guidance
-- uf_arity will typically be equal to (idArity id),
-- but may be less for InlineRules
let
n_val_args = length arg_infos
saturated = n_val_args >= uf_arity
result | yes_or_no = Just unf_template
| otherwise = Nothing
interesting_args = any nonTriv arg_infos
-- NB: (any nonTriv arg_infos) looks at the
-- over-saturated args too which is "wrong";
-- but if over-saturated we inline anyway.
-- some_benefit is used when the RHS is small enough
-- and the call has enough (or too many) value
-- arguments (ie n_val_args >= arity). But there must
-- be *something* interesting about some argument, or the
-- result context, to make it worth inlining
some_benefit
| not saturated = interesting_args -- Under-saturated
-- Note [Unsaturated applications]
| n_val_args > uf_arity = True -- Over-saturated
| otherwise = interesting_args -- Saturated
|| interesting_saturated_call
interesting_saturated_call
= case cont_info of
BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions]
CaseCtxt -> not (lone_variable && is_cheap) -- Note [Lone variables]
ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt]
ValAppCtxt -> True -- Note [Cast then apply]
(yes_or_no, extra_doc)
= case guidance of
UnfNever -> (False, empty)
UnfWhen unsat_ok boring_ok
-> (enough_args && (boring_ok || some_benefit), empty )
where -- See Note [INLINE for small functions]
enough_args = saturated || (unsat_ok && n_val_args > 0)
UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
-> ( is_cheap && some_benefit && small_enough
, (text "discounted size =" <+> int discounted_size) )
where
discounted_size = size - discount
small_enough = discounted_size <= opt_UF_UseThreshold
discount = computeDiscount uf_arity arg_discounts
res_discount arg_infos cont_info
in
if (dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags) then
pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
| dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
= pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
(vcat [text "arg infos" <+> ppr arg_infos,
text "uf arity" <+> ppr uf_arity,
text "interesting continuation" <+> ppr cont_info,
......@@ -834,10 +798,57 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
text "guidance" <+> ppr guidance,
extra_doc,
text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
result
else
result
}
result
| otherwise = result
where
n_val_args = length arg_infos
saturated = n_val_args >= uf_arity
result | yes_or_no = Just unf_template
| otherwise = Nothing
interesting_args = any nonTriv arg_infos
-- NB: (any nonTriv arg_infos) looks at the
-- over-saturated args too which is "wrong";
-- but if over-saturated we inline anyway.
-- some_benefit is used when the RHS is small enough
-- and the call has enough (or too many) value
-- arguments (ie n_val_args >= arity). But there must
-- be *something* interesting about some argument, or the
-- result context, to make it worth inlining
some_benefit
| not saturated = interesting_args -- Under-saturated
-- Note [Unsaturated applications]
| n_val_args > uf_arity = True -- Over-saturated
| otherwise = interesting_args -- Saturated
|| interesting_saturated_call
interesting_saturated_call
= case cont_info of
BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions]
CaseCtxt -> not (lone_variable && is_cheap) -- Note [Lone variables]
ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt]
ValAppCtxt -> True -- Note [Cast then apply]
(yes_or_no, extra_doc)
= case guidance of
UnfNever -> (False, empty)
UnfWhen unsat_ok boring_ok
-> (enough_args && (boring_ok || some_benefit), empty )
where -- See Note [INLINE for small functions]
enough_args = saturated || (unsat_ok && n_val_args > 0)
UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
-> ( is_cheap && some_benefit && small_enough
, (text "discounted size =" <+> int discounted_size) )
where
discounted_size = size - discount
small_enough = discounted_size <= opt_UF_UseThreshold
discount = computeDiscount uf_arity arg_discounts
res_discount arg_infos cont_info
\end{code}
Note [RHS of lets]
......
......@@ -10,7 +10,6 @@ module CoreMonad (
-- * Configuration of the core-to-core passes
CoreToDo(..),
SimplifierMode(..),
SimplifierSwitch(..),
FloatOutSwitches(..),
getCoreToDo, dumpSimplPhase,
......@@ -63,7 +62,7 @@ import Module ( PackageId, Module )
import DynFlags
import StaticFlags
import Rules ( RuleBase )
import BasicTypes ( CompilerPhase )
import BasicTypes ( CompilerPhase(..) )
import Annotations
import Id ( Id )
......@@ -186,8 +185,8 @@ displayLintResults dflags pass warns errs binds
showLintWarnings :: CoreToDo -> Bool
-- Disable Lint warnings on the first simplifier pass, because
-- there may be some INLINE knots still tied, which is tiresomely noisy
showLintWarnings (CoreDoSimplify (SimplGently {}) _ _) = False
showLintWarnings _ = True
showLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False
showLintWarnings _ = True
\end{code}
......@@ -204,10 +203,9 @@ data CoreToDo -- These are diff core-to-core passes,
-- as many times as you like.
= CoreDoSimplify -- The core-to-core simplifier.
Int -- Max iterations
SimplifierMode
Int -- Max iterations
[SimplifierSwitch] -- Each run of the simplifier can take a different
-- set of simplifier-specific flags.
| CoreDoFloatInwards
| CoreDoFloatOutwards FloatOutSwitches
| CoreLiberateCase
......@@ -254,8 +252,8 @@ coreDumpFlag CoreDoGlomBinds = Nothing
coreDumpFlag (CoreDoPasses {}) = Nothing
instance Outputable CoreToDo where
ppr (CoreDoSimplify md n _) = ptext (sLit "Simplifier")
<+> ppr md
ppr (CoreDoSimplify n md) = ptext (sLit "Simplifier")
<+> ppr md
<+> ptext (sLit "max-iterations=") <> int n
ppr CoreDoFloatInwards = ptext (sLit "Float inwards")
ppr (CoreDoFloatOutwards f) = ptext (sLit "Float out") <> parens (ppr f)
......@@ -279,50 +277,56 @@ instance Outputable CoreToDo where
\begin{code}
data SimplifierMode -- See comments in SimplMonad
= SimplGently
{ sm_rules :: Bool -- Whether RULES are enabled
, sm_inline :: Bool } -- Whether inlining is enabled
| SimplPhase
{ sm_num :: Int -- Phase number; counts downward so 0 is last phase
, sm_names :: [String] } -- Name(s) of the phase
= SimplMode
{ sm_names :: [String] -- Name(s) of the phase
, sm_phase :: CompilerPhase
, sm_rules :: Bool -- Whether RULES are enabled
, sm_inline :: Bool -- Whether inlining is enabled
, sm_case_case :: Bool -- Whether case-of-case is enabled
, sm_eta_expand :: Bool -- Whether eta-expansion is enabled
}
instance Outputable SimplifierMode where
ppr (SimplPhase { sm_num = n, sm_names = ss })
= ptext (sLit "Phase") <+> int n <+> brackets (text (concat $ intersperse "," ss))
ppr (SimplGently { sm_rules = r, sm_inline = i })
= ptext (sLit "gentle") <>
brackets (pp_flag r (sLit "rules") <> comma <>
pp_flag i (sLit "inline"))
ppr (SimplMode { sm_phase = p, sm_names = ss
, sm_rules = r, sm_inline = i
, sm_eta_expand = eta, sm_case_case = cc })
= ptext (sLit "SimplMode") <+> braces (
sep [ ptext (sLit "Phase =") <+> ppr p <+>
brackets (text (concat $ intersperse "," ss)) <> comma
, pp_flag i (sLit "inline") <> comma
, pp_flag r (sLit "rules") <> comma
, pp_flag eta (sLit "eta-expand") <> comma
, pp_flag cc (sLit "case-of-case") ])
where
pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s
data SimplifierSwitch
= NoCaseOfCase
\end{code}
\begin{code}
data FloatOutSwitches = FloatOutSwitches {
floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level
floatOutConstants :: Bool, -- ^ True <=> float constants to top level,
-- even if they do not escape a lambda
floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications
floatOutLambdas :: Maybe Int, -- ^ Just n <=> float lambdas to top level, if
-- doing so will abstract over n or fewer
-- value variables
-- Nothing <=> float all lambdas to top level,
-- regardless of how many free variables
-- Just 0 is the vanilla case: float a lambda
-- iff it has no free vars
floatOutConstants :: Bool, -- ^ True <=> float constants to top level,
-- even if they do not escape a lambda
floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications
-- based on arity information.
}
}
instance Outputable FloatOutSwitches where
ppr = pprFloatOutSwitches
pprFloatOutSwitches :: FloatOutSwitches -> SDoc
pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
<+> pp_not (floatOutConstants sw) <+> text "constants"
where
pp_not True = empty
pp_not False = text "not"
-- | Switches that specify the minimum amount of floating out
-- gentleFloatOutSwitches :: FloatOutSwitches
-- gentleFloatOutSwitches = FloatOutSwitches False False
pprFloatOutSwitches sw
= ptext (sLit "FOS") <+> (braces $
sep $ punctuate comma $
[ ptext (sLit "Lam =") <+> ppr (floatOutLambdas sw)
, ptext (sLit "Consts =") <+> ppr (floatOutConstants sw)
, ptext (sLit "PAPs =") <+> ppr (floatOutPartialApplications sw) ])
\end{code}
......@@ -337,30 +341,41 @@ getCoreToDo :: DynFlags -> [CoreToDo]
getCoreToDo dflags
= core_todo
where
opt_level = optLevel dflags
phases = simplPhases dflags
opt_level = optLevel dflags
phases = simplPhases dflags
max_iter = maxSimplIterations dflags
strictness = dopt Opt_Strictness dflags
full_laziness = dopt Opt_FullLaziness dflags
do_specialise = dopt Opt_Specialise dflags
do_float_in = dopt Opt_FloatIn dflags
cse = dopt Opt_CSE dflags
spec_constr = dopt Opt_SpecConstr dflags
liberate_case = dopt Opt_LiberateCase dflags
rule_check = ruleCheck dflags
rule_check = ruleCheck dflags
strictness = dopt Opt_Strictness dflags
full_laziness = dopt Opt_FullLaziness dflags
do_specialise = dopt Opt_Specialise dflags
do_float_in = dopt Opt_FloatIn dflags
cse = dopt Opt_CSE dflags
spec_constr = dopt Opt_SpecConstr dflags
liberate_case = dopt Opt_LiberateCase dflags
static_args = dopt Opt_StaticArgumentTransformation dflags
rules_on = dopt Opt_EnableRewriteRules dflags
eta_expand_on = dopt Opt_DoLambdaEtaExpansion dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
maybe_strictness_before phase
= runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
base_mode = SimplMode { sm_phase = panic "base_mode"
, sm_names = []
, sm_rules = rules_on
, sm_eta_expand = eta_expand_on
, sm_inline = True
, sm_case_case = True }
simpl_phase phase names iter
= CoreDoPasses
[ maybe_strictness_before phase
, CoreDoSimplify (SimplPhase phase names)
iter []
, maybe_rule_check phase
, CoreDoSimplify iter
(base_mode { sm_phase = Phase phase
, sm_names = names })
, maybe_rule_check (Phase phase)
]
vectorisation
......@@ -380,21 +395,18 @@ getCoreToDo dflags
-- strictness in the function sumcode' if augment is not inlined
-- before strictness analysis runs
simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
| phase <- [phases, phases-1 .. 1] ]
| phase <- [phases, phases-1 .. 1] ]
-- initial simplify: mk specialiser happy: minimum effort please
simpl_gently = CoreDoSimplify
(SimplGently { sm_rules = True, sm_inline = False })
-- See Note [Gentle mode] and
-- Note [RULEs enabled in SimplGently] in SimplUtils
max_iter
[
NoCaseOfCase -- Don't do case-of-case transformations.
-- This makes full laziness work better
]
simpl_gently = CoreDoSimplify max_iter
(base_mode { sm_phase = InitialPhase
, sm_names = ["Gentle"]
, sm_rules = True -- Note [RULEs enabled in SimplGently]
, sm_inline = False
, sm_case_case = False })
-- Don't do case-of-case transformations.
-- This makes full laziness work better
core_todo =
if opt_level == 0 then
......@@ -421,7 +433,7 @@ getCoreToDo dflags
runWhen full_laziness $
CoreDoFloatOutwards FloatOutSwitches {
floatOutLambdas = False,
floatOutLambdas = Just 0,
floatOutConstants = True,
floatOutPartialApplications = False },
-- Was: gentleFloatOutSwitches
......@@ -467,7 +479,7 @@ getCoreToDo dflags
runWhen full_laziness $
CoreDoFloatOutwards FloatOutSwitches {
floatOutLambdas = False,
floatOutLambdas = floatLamArgs dflags,
floatOutConstants = True,
floatOutPartialApplications = True },
-- nofib/spectral/hartel/wang doubles in speed if you
......@@ -484,7 +496,7 @@ getCoreToDo dflags
runWhen do_float_in CoreDoFloatInwards,
maybe_rule_check 0,
maybe_rule_check (Phase 0),
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
......@@ -497,7 +509,7 @@ getCoreToDo dflags
runWhen spec_constr CoreDoSpecConstr,
maybe_rule_check 0,
maybe_rule_check (Phase 0),
-- Final clean-up simplification:
simpl_phase 0 ["final"] max_iter
......@@ -532,17 +544,35 @@ dumpSimplPhase dflags mode
_ -> phase_name s
phase_num :: Int -> Bool
phase_num n = case mode of
SimplPhase k _ -> n == k
_ -> False
phase_num n = case sm_phase mode of
Phase k -> n == k
_ -> False
phase_name :: String -> Bool
phase_name s = case mode of
SimplGently {} -> s == "gentle"
SimplPhase { sm_names = ss } -> s `elem` ss
phase_name s = s `elem` sm_names mode
\end{code}
Note [RULEs enabled in SimplGently]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RULES are enabled when doing "gentle" simplification. Two reasons:
* We really want the class-op cancellation to happen:
op (df d1 d2) --> $cop3 d1 d2
because this breaks the mutual recursion between 'op' and 'df'
* I wanted the RULE
lift String ===> ...
to work in Template Haskell when simplifying
splices, so we get simpler code for literal strings
But watch out: list fusion can prevent floating. So use phase control
to switch off those rules until after floating.
Currently (Oct10) I think that sm_rules is always True, so we
could remove it.
%************************************************************************
%* *
Counting and logging
......
%
% (c) The AQUA Project, Glasgow University, 1993-1998
o% (c) The AQUA Project, Glasgow University, 1993-1998
%
\section[SimplMonad]{The simplifier Monad}
......@@ -12,18 +12,14 @@ module SimplEnv (
-- The simplifier mode
setMode, getMode, updMode,
-- Switch checker
SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
isAmongSimpl, intSwitchSet, switchIsOn,
setEnclosingCC, getEnclosingCC,
setEnclosingCC, getEnclosingCC,
-- Environments
SimplEnv(..), StaticEnv, pprSimplEnv, -- Temp not abstract
mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
getSimplRules, inGentleMode,
getSimplRules,
SimplSR(..), mkContEx, substId, lookupRecBndr,
......@@ -106,8 +102,7 @@ data SimplEnv
-- wrt the original expression
seMode :: SimplifierMode,
seChkr :: SwitchChecker,
seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
-- The current substitution
seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
......@@ -223,18 +218,14 @@ seIdSubst:
\begin{code}
mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
mkSimplEnv switches mode
= SimplEnv { seChkr = switches, seCC = subsumedCCS,
mkSimplEnv :: SimplifierMode -> SimplEnv
mkSimplEnv mode
= SimplEnv { seCC = subsumedCCS,
seMode = mode, seInScope = emptyInScopeSet,
seFloats = emptyFloats,
seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
-- The top level "enclosing CC" is "SUBSUMED".
---------------------
getSwitchChecker :: SimplEnv -> SwitchChecker
getSwitchChecker env = seChkr env
---------------------
getMode :: SimplEnv -> SimplifierMode
getMode env = seMode env
......@@ -245,11 +236,6 @@ setMode mode env = env { seMode = mode }