%
-% (c) The AQUA Project, Glasgow University, 1993-1998
+o% (c) The AQUA Project, Glasgow University, 1993-1998
%
\section[SimplMonad]{The simplifier Monad}
\begin{code}
module SimplEnv (
- InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
- OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
+ InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar,
+ OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar,
+ InCoercion, OutCoercion,
-- The simplifier mode
- setMode, getMode,
+ setMode, getMode, updMode,
- -- Switch checker
- SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
- isAmongSimpl, intSwitchSet, switchIsOn,
-
- setEnclosingCC, getEnclosingCC,
+ setEnclosingCC, getEnclosingCC,
-- Environments
- SimplEnv, mkSimplEnv, extendIdSubst, extendTvSubst,
+ SimplEnv(..), StaticEnv, pprSimplEnv, -- Temp not abstract
+ mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, SimplEnv.extendCvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
- getRules, refineSimplEnv,
+ getSimplRules,
- SimplSR(..), mkContEx, substId,
+ SimplSR(..), mkContEx, substId, lookupRecBndr,
simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
- simplBinder, simplBinders, addLetIdInfo,
- substExpr, substTy,
+ simplBinder, simplBinders, addBndrRules,
+ substExpr, substTy, substTyVar, getTvSubst,
+ getCvSubst, substCo, substCoVar,
+ mkCoreSubst,
-- Floats
- FloatsWith, FloatsWithExpr,
- Floats, emptyFloats, isEmptyFloats, unitFloat, addFloats, flattenFloats,
- allLifted, wrapFloats, floatBinds,
- addAuxiliaryBind,
+ Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
+ wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
+ doFloatFromRhs, getFloats
) where
#include "HsVersions.h"
-import SimplMonad
-import Id ( Id, idType, idOccInfo, idUnfolding, setIdUnfolding )
-import IdInfo ( IdInfo, vanillaIdInfo, occInfo, setOccInfo, specInfo, setSpecInfo,
- arityInfo, setArityInfo, workerInfo, setWorkerInfo,
- unfoldingInfo, setUnfoldingInfo, isEmptySpecInfo,
- unknownArity, workerExists
- )
+import SimplMonad
+import CoreMonad ( SimplifierMode(..) )
+import IdInfo
import CoreSyn
-import Unify ( TypeRefinement )
-import Rules ( RuleBase )
-import CoreUtils ( needsCaseBinding )
-import CostCentre ( CostCentreStack, subsumedCCS )
-import Var
+import CoreUtils
+import CostCentre
+import Var
import VarEnv
-import VarSet ( isEmptyVarSet )
+import VarSet
import OrdList
-
-import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
-import qualified Type ( substTy, substTyVarBndr )
-
-import Type ( Type, TvSubst(..), TvSubstEnv, composeTvSubst,
- isUnLiftedType, seqType, tyVarsOfType )
-import BasicTypes ( OccInfo(..), isFragileOcc )
-import DynFlags ( SimplifierMode(..) )
-import Util ( mapAccumL )
+import Id
+import MkCore
+import TysWiredIn
+import qualified CoreSubst
+import qualified Type
+import Type hiding ( substTy, substTyVarBndr, substTyVar )
+import qualified Coercion
+import Coercion hiding ( substCo, substTy, substCoVar, substCoVarBndr, substTyVarBndr )
+import BasicTypes
+import MonadUtils
import Outputable
+import FastString
+
+import Data.List
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-type InBinder = CoreBndr
-type InId = Id -- Not yet cloned
-type InType = Type -- Ditto
-type InBind = CoreBind
-type InExpr = CoreExpr
-type InAlt = CoreAlt
-type InArg = CoreArg
-
-type OutBinder = CoreBndr
-type OutId = Id -- Cloned
-type OutTyVar = TyVar -- Cloned
-type OutType = Type -- Cloned
-type OutBind = CoreBind
-type OutExpr = CoreExpr
-type OutAlt = CoreAlt
-type OutArg = CoreArg
+type InBndr = CoreBndr
+type InVar = Var -- Not yet cloned
+type InId = Id -- Not yet cloned
+type InType = Type -- Ditto
+type InBind = CoreBind
+type InExpr = CoreExpr
+type InAlt = CoreAlt
+type InArg = CoreArg
+type InCoercion = Coercion
+
+type OutBndr = CoreBndr
+type OutVar = Var -- Cloned
+type OutId = Id -- Cloned
+type OutTyVar = TyVar -- Cloned
+type OutType = Type -- Cloned
+type OutCoercion = Coercion
+type OutBind = CoreBind
+type OutExpr = CoreExpr
+type OutAlt = CoreAlt
+type OutArg = CoreArg
\end{code}
%************************************************************************
\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)
+ seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
- -- Rules from other modules
- seExtRules :: RuleBase,
+ -- The current substitution
+ seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
+ seCvSubst :: CvSubstEnv, -- InTyCoVar |--> OutCoercion
+ 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
-
- -- The current substitution
- seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
- seIdSubst :: SimplIdSubst -- InId |--> OutExpr
+ -- Includes all variables bound by seFloats
+ seFloats :: Floats
+ -- See Note [Simplifier floats]
}
+type StaticEnv = SimplEnv -- Just the static part is relevant
+
+pprSimplEnv :: SimplEnv -> SDoc
+-- Used for debugging; selective
+pprSimplEnv env
+ = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
+ ptext (sLit "IdSubst:") <+> ppr (seIdSubst env),
+ ptext (sLit "InScope:") <+> vcat (map ppr_one in_scope_vars)
+ ]
+ where
+ in_scope_vars = varEnvElts (getInScopeVars (seInScope env))
+ ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)
+ | otherwise = ppr v
+
type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
+ -- See Note [Extending the Subst] in CoreSubst
data SimplSR
= DoneEx OutExpr -- Completed term
- | DoneId OutId OccInfo -- Completed term variable, with occurrence info
+ | DoneId OutId -- Completed term variable
| ContEx TvSubstEnv -- A suspended substitution
+ CvSubstEnv
SimplIdSubst
InExpr
-\end{code}
+instance Outputable SimplSR where
+ ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
+ ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
+ ppr (ContEx _tv _cv _id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
+ ppr (filter_env tv), ppr (filter_env id) -}]
+ -- where
+ -- fvs = exprFreeVars e
+ -- filter_env env = filterVarEnv_Directly keep env
+ -- keep uniq _ = uniq `elemUFM_Directly` fvs
+\end{code}
+Note [SimplEnv invariants]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
seInScope:
The in-scope part of Subst includes *all* in-scope TyVars and Ids
The elements of the set may have better IdInfo than the
a77 -> a77
from the substitution, when we decide not to clone a77, but it's quite
legitimate to put the mapping in the substitution anyway.
-
- Indeed, we do so when we want to pass fragile OccInfo to the
- occurrences of the variable; we add a substitution
- x77 -> DoneId x77 occ
- to record x's occurrence information.]
Furthermore, consider
let x = case k of I# x77 -> ... in
Of course, the substitution *must* applied! Things in its domain
simply aren't necessarily bound in the result.
-* substId adds a binding (DoneId new_id occ) to the substitution if
- EITHER the Id's unique has changed
- OR the Id has interesting occurrence information
- So in effect you can only get to interesting occurrence information
- by looking up the *old* Id; it's not really attached to the new id
- at all.
+* substId adds a binding (DoneId new_id) to the substitution if
+ the Id's unique has changed
Note, though that the substitution isn't necessarily extended
- if the type changes. Why not? Because of the next point:
+ if the type of the Id changes. Why not? Because of the next point:
* We *always, always* finish by looking up in the in-scope set
any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
That's why the "set" is actually a VarEnv Var
-Note [GADT type refinement]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we come to a GADT pattern match that refines the in-scope types, we
- a) Refine the types of the Ids in the in-scope set, seInScope.
- For exmaple, consider
- data T a where
- Foo :: T (Bool -> Bool)
-
- (\ (x::T a) (y::a) -> case x of { Foo -> y True }
-
- Technically this is well-typed, but exprType will barf on the
- (y True) unless we refine the type on y's occurrence.
-
- b) Refine the range of the type substitution, seTvSubst.
- Very similar reason to (a).
-
- NB: we don't refine the range of the SimplIdSubst, because it's always
- interpreted relative to the seInScope (see substId)
-
-For (b) we need to be a little careful. Specifically, we compose the refinement
-with the type substitution. Suppose
- The substitution was [a->b, b->a]
- and the refinement was [b->Int]
- Then we want [a->Int, b->a]
-
-But also if
- The substitution was [a->b]
- and the refinement was [b->Int]
- Then we want [a->Int, b->Int]
- becuase b might be both an InTyVar and OutTyVar
-
-
\begin{code}
-mkSimplEnv :: SimplifierMode -> SwitchChecker -> RuleBase -> SimplEnv
-mkSimplEnv mode switches rules
- = SimplEnv { seChkr = switches, seCC = subsumedCCS,
- seMode = mode, seInScope = emptyInScopeSet,
- seExtRules = rules,
- seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
+mkSimplEnv :: SimplifierMode -> SimplEnv
+mkSimplEnv mode
+ = SimplEnv { seCC = subsumedCCS
+ , seMode = mode
+ , seInScope = init_in_scope
+ , seFloats = emptyFloats
+ , seTvSubst = emptyVarEnv
+ , seCvSubst = emptyVarEnv
+ , seIdSubst = emptyVarEnv }
-- The top level "enclosing CC" is "SUBSUMED".
----------------------
-getSwitchChecker :: SimplEnv -> SwitchChecker
-getSwitchChecker env = seChkr env
+init_in_scope :: InScopeSet
+init_in_scope = mkInScopeSet (unitVarSet (mkWildValBinder unitTy))
+ -- See Note [WildCard binders]
+\end{code}
----------------------
+Note [WildCard binders]
+~~~~~~~~~~~~~~~~~~~~~~~
+The program to be simplified may have wild binders
+ case e of wild { p -> ... }
+We want to *rename* them away, so that there are no
+occurrences of 'wild-id' (with wildCardKey). The easy
+way to do that is to start of with a representative
+Id in the in-scope set
+
+There can be be *occurrences* of wild-id. For example,
+MkCore.mkCoreApp transforms
+ e (a /# b) --> case (a /# b) of wild { DEFAULT -> e wild }
+This is ok provided 'wild' isn't free in 'e', and that's the delicate
+thing. Generally, you want to run the simplifier to get rid of the
+wild-ids before doing much else.
+
+It's a very dark corner of GHC. Maybe it should be cleaned up.
+
+\begin{code}
getMode :: SimplEnv -> SimplifierMode
getMode env = seMode env
setMode :: SimplifierMode -> SimplEnv -> SimplEnv
setMode mode env = env { seMode = mode }
+updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
+updMode upd env = env { seMode = upd (seMode env) }
+
---------------------
getEnclosingCC :: SimplEnv -> CostCentreStack
getEnclosingCC env = seCC env
---------------------
extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
- = env {seIdSubst = extendVarEnv subst var res}
+ = ASSERT2( isId var && not (isCoVar var), ppr var )
+ env {seIdSubst = extendVarEnv subst var res}
extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
= env {seTvSubst = extendVarEnv subst var res}
+extendCvSubst :: SimplEnv -> CoVar -> Coercion -> SimplEnv
+extendCvSubst env@(SimplEnv {seCvSubst = subst}) var res
+ = env {seCvSubst = extendVarEnv subst var res}
+
---------------------
getInScope :: SimplEnv -> InScopeSet
getInScope env = seInScope env
setInScopeSet env in_scope = env {seInScope = in_scope}
setInScope :: SimplEnv -> SimplEnv -> SimplEnv
-setInScope env env_with_in_scope = setInScopeSet env (getInScope env_with_in_scope)
+-- Set the in-scope set, and *zap* the floats
+setInScope env env_with_scope
+ = env { seInScope = seInScope env_with_scope,
+ seFloats = emptyFloats }
+
+setFloats :: SimplEnv -> SimplEnv -> SimplEnv
+-- Set the in-scope set *and* the floats
+setFloats env env_with_floats
+ = env { seInScope = seInScope env_with_floats,
+ seFloats = seFloats env_with_floats }
addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
-- The new Ids are guaranteed to be freshly allocated
-- 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
-zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
+zapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
-setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
-setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
+setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
+setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }
mkContEx :: SimplEnv -> InExpr -> SimplSR
-mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
+mkContEx (SimplEnv { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }) e = ContEx tvs cvs ids e
+\end{code}
-isEmptySimplSubst :: SimplEnv -> Bool
-isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
- = isEmptyVarEnv tvs && isEmptyVarEnv ids
----------------------
-getRules :: SimplEnv -> RuleBase
-getRules = seExtRules
-\end{code}
- GADT stuff
+%************************************************************************
+%* *
+\subsection{Floats}
+%* *
+%************************************************************************
+
+Note [Simplifier floats]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+The Floats is a bunch of bindings, classified by a FloatFlag.
+
+ NonRec x (y:ys) FltLifted
+ Rec [(x,rhs)] FltLifted
-Given an idempotent substitution, generated by the unifier, use it to
-refine the environment
+ NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
+
+ NonRec x# (a /# b) FltCareful
+ NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
+ NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
+ -- (where f :: Int -> Int#)
\begin{code}
-refineSimplEnv :: SimplEnv -> TypeRefinement -> SimplEnv
--- The TvSubstEnv is the refinement, and it refines OutTyVars into OutTypes
-refineSimplEnv env@(SimplEnv { seTvSubst = tv_subst, seInScope = in_scope })
- (refine_tv_subst, all_bound_here)
- = env { seTvSubst = composeTvSubst in_scope refine_tv_subst tv_subst,
- seInScope = in_scope' }
+data Floats = Floats (OrdList OutBind) FloatFlag
+ -- See Note [Simplifier floats]
+
+data FloatFlag
+ = FltLifted -- All bindings are lifted and lazy
+ -- Hence ok to float to top level, or recursive
+
+ | FltOkSpec -- All bindings are FltLifted *or*
+ -- strict (perhaps because unlifted,
+ -- perhaps because of a strict binder),
+ -- *and* ok-for-speculation
+ -- Hence ok to float out of the RHS
+ -- of a lazy non-recursive let binding
+ -- (but not to top level, or into a rec group)
+
+ | FltCareful -- At least one binding is strict (or unlifted)
+ -- and not guaranteed cheap
+ -- Do not float these bindings out of a lazy let
+
+instance Outputable Floats where
+ ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
+
+instance Outputable FloatFlag where
+ ppr FltLifted = ptext (sLit "FltLifted")
+ ppr FltOkSpec = ptext (sLit "FltOkSpec")
+ ppr FltCareful = ptext (sLit "FltCareful")
+
+andFF :: FloatFlag -> FloatFlag -> FloatFlag
+andFF FltCareful _ = FltCareful
+andFF FltOkSpec FltCareful = FltCareful
+andFF FltOkSpec _ = FltOkSpec
+andFF FltLifted flt = flt
+
+classifyFF :: CoreBind -> FloatFlag
+classifyFF (Rec _) = FltLifted
+classifyFF (NonRec bndr rhs)
+ | not (isStrictId bndr) = FltLifted
+ | exprOkForSpeculation rhs = FltOkSpec
+ | otherwise = FltCareful
+
+doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
+doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
+ = not (isNilOL fs) && want_to_float && can_float
where
- in_scope'
- | all_bound_here = in_scope
- -- The tvs are the tyvars bound here. If only they
- -- are refined, there's no need to do anything
- | otherwise = mapInScopeSet refine_id in_scope
-
- refine_id v -- Only refine its type; any rules will get
- -- refined if they are used (I hope)
- | isId v = setIdType v (Type.substTy refine_subst (idType v))
- | otherwise = v
- refine_subst = TvSubst in_scope refine_tv_subst
+ want_to_float = isTopLevel lvl || exprIsExpandable rhs
+ can_float = case ff of
+ FltLifted -> True
+ FltOkSpec -> isNotTopLevel lvl && isNonRec rec
+ FltCareful -> isNotTopLevel lvl && isNonRec rec && str
\end{code}
+
+\begin{code}
+emptyFloats :: Floats
+emptyFloats = Floats nilOL FltLifted
+
+unitFloat :: OutBind -> Floats
+-- A single-binding float
+unitFloat bind = Floats (unitOL bind) (classifyFF bind)
+
+addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
+-- Add a non-recursive binding and extend the in-scope set
+-- The latter is important; the binder may already be in the
+-- in-scope set (although it might also have been created with newId)
+-- but it may now have more IdInfo
+addNonRec env id rhs
+ = id `seq` -- This seq forces the Id, and hence its IdInfo,
+ -- and hence any inner substitutions
+ env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
+ seInScope = extendInScopeSet (seInScope env) id }
+
+extendFloats :: SimplEnv -> OutBind -> SimplEnv
+-- Add these bindings to the floats, and extend the in-scope env too
+extendFloats env bind
+ = env { seFloats = seFloats env `addFlts` unitFloat bind,
+ seInScope = extendInScopeSetList (seInScope env) bndrs }
+ where
+ bndrs = bindersOf bind
+
+addFloats :: SimplEnv -> SimplEnv -> SimplEnv
+-- Add the floats for env2 to env1;
+-- *plus* the in-scope set for env2, which is bigger
+-- than that for env1
+addFloats env1 env2
+ = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
+ seInScope = seInScope env2 }
+
+addFlts :: Floats -> Floats -> Floats
+addFlts (Floats bs1 l1) (Floats bs2 l2)
+ = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
+
+zapFloats :: SimplEnv -> SimplEnv
+zapFloats env = env { seFloats = emptyFloats }
+
+addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
+-- Flattens the floats from env2 into a single Rec group,
+-- prepends the floats from env1, and puts the result back in env2
+-- This is all very specific to the way recursive bindings are
+-- handled; see Simplify.simplRecBind
+addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
+ = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )
+ env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
+
+wrapFloats :: SimplEnv -> OutExpr -> OutExpr
+wrapFloats env expr = wrapFlts (seFloats env) expr
+
+wrapFlts :: Floats -> OutExpr -> OutExpr
+-- Wrap the floats around the expression, using case-binding where necessary
+wrapFlts (Floats bs _) body = foldrOL wrap body bs
+ where
+ wrap (Rec prs) body = Let (Rec prs) body
+ wrap (NonRec b r) body = bindNonRec b r body
+
+getFloats :: SimplEnv -> [CoreBind]
+getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
+
+isEmptyFloats :: SimplEnv -> Bool
+isEmptyFloats env = isEmptyFlts (seFloats env)
+
+isEmptyFlts :: Floats -> Bool
+isEmptyFlts (Floats bs _) = isNilOL bs
+
+floatBinds :: Floats -> [OutBind]
+floatBinds (Floats bs _) = fromOL bs
+\end{code}
+
+
%************************************************************************
%* *
Substitution of Vars
%* *
%************************************************************************
+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 -> Id -> SimplSR
+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 NoOccInfo
- | otherwise -- A local Id
- = case lookupVarEnv ids v of
- Just (DoneId v occ) -> DoneId (refine v) occ
- Just res -> res
- Nothing -> let v' = refine v
- in DoneId v' (idOccInfo v')
- -- We don't put LoopBreakers in the substitution (unless then need
- -- to be cloned for name-clash rasons), so the idOccInfo is
- -- very important! If isFragileOcc returned True for
- -- loop breakers we could avoid this call, but at the expense
- -- of adding more to the substitution, and building new Ids
- -- a bit more often than really necessary
- where
+ = 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)) -> DoneId (refine in_scope v)
+ Just res -> res -- DoneEx non-var, or ContEx
+
-- Get the most up-to-date thing from the in-scope set
-- Even though it isn't in the substitution, it may be in
- -- the in-scope set with a different type (we only use the
- -- substitution if the unique changes).
- refine v = case lookupInScope in_scope v of
- Just v' -> v'
- Nothing -> WARN( True, ppr v ) v -- This is an error!
+ -- the in-scope set with better IdInfo
+refine :: InScopeSet -> Var -> Var
+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,
+-- but where we have not yet done its RHS
+lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
+ = case lookupVarEnv ids v of
+ Just (DoneId v) -> v
+ Just _ -> pprPanic "lookupRecBndr" (ppr v)
+ Nothing -> refine in_scope v
\end{code}
\begin{code}
simplBinders, simplLamBndrs
- :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
-simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
-simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
+ :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
+simplBinders env bndrs = mapAccumLM simplBinder env bndrs
+simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
-------------
-simplBinder :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
+simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
-- Used for lambda and case-bound variables
-- Clone Id if necessary, substitute type
-- Return with IdInfo already substituted, but (fragile) occurrence info zapped
-------------
simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
-- Used for lambda binders. These sometimes have unfoldings added by
--- the worker/wrapper pass that must be preserved, becuase they can't
+-- the worker/wrapper pass that must be preserved, because they can't
-- be reconstructed from context. For example:
-- f x = case x of (a,b) -> fw a b x
-- fw a b x{=(a,b)} = ...
-- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
simplLamBndr env bndr
- | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr -- Normal case
- | otherwise = seqId id2 `seq` return (env', id2)
+ | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
+ | otherwise = simplBinder env bndr -- Normal case
where
old_unf = idUnfolding bndr
- (env', id1) = substIdBndr env bndr
- id2 = id1 `setIdUnfolding` substUnfolding env old_unf
+ (env1, id1) = substIdBndr env bndr
+ id2 = id1 `setIdUnfolding` substUnfolding env old_unf
+ env2 = modifyInScope env1 id2
---------------
-substIdBndr :: SimplEnv -> Id -- Substitition and Id to transform
- -> (SimplEnv, Id) -- Transformed pair
+---------------
+simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
+-- A non-recursive let binder
+simplNonRecBndr env id
+ = do { let (env1, id1) = substIdBndr env id
+ ; seqId id1 `seq` return (env1, id1) }
--- Returns with:
--- * Unique changed if necessary
+---------------
+simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
+-- Recursive let binders
+simplRecBndrs env@(SimplEnv {}) ids
+ = do { let (env1, ids1) = mapAccumL substIdBndr env ids
+ ; seqIds ids1 `seq` return env1 }
+
+---------------
+substIdBndr :: SimplEnv -> InBndr -> (SimplEnv, OutBndr)
+-- Might be a coercion variable
+substIdBndr env bndr
+ | isCoVar bndr = substCoVarBndr env bndr
+ | otherwise = substNonCoVarIdBndr env bndr
+
+---------------
+substNonCoVarIdBndr
+ :: SimplEnv
+ -> InBndr -- Env and binder to transform
+ -> (SimplEnv, OutBndr)
+-- Clone Id if necessary, substitute its type
+-- Return an Id with its
-- * Type substituted
--- * Unfolding zapped
--- * Rules, worker, lbvar info all substituted
--- * Fragile occurrence info zapped
--- * The in-scope set extended with the returned Id
--- * The substitution extended with a DoneId if unique changed
--- In this case, the var in the DoneId is the same as the
--- var returned
-
-substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
- old_id
- = (env { seInScope = in_scope `extendInScopeSet` new_id,
+-- * UnfoldingInfo, Rules, WorkerInfo zapped
+-- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
+-- * Robust info, retained especially arity and demand info,
+-- so that they are available to occurrences that occur in an
+-- earlier binding of a letrec
+--
+-- For the robust info, see Note [Arity robustness]
+--
+-- Augment the substitution if the unique changed
+-- Extend the in-scope set with the new Id
+--
+-- Similar to CoreSubst.substIdBndr, except that
+-- the type of id_subst differs
+-- all fragile info is zapped
+substNonCoVarIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
+ old_id
+ = ASSERT2( not (isCoVar old_id), ppr old_id )
+ (env { seInScope = in_scope `extendInScopeSet` new_id,
seIdSubst = new_subst }, new_id)
where
- -- id1 is cloned if necessary
- id1 = uniqAway in_scope old_id
-
- -- id2 has its type zapped
- id2 = substIdType env id1
-
- -- new_id has the final IdInfo
- subst = mkCoreSubst env
- new_id = maybeModifyIdInfo (substIdInfo subst) id2
+ id1 = uniqAway in_scope old_id
+ id2 = substIdType env id1
+ new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
+ -- and fragile OccInfo
- -- Extend the substitution if the unique has changed
+ -- Extend the substitution if the unique has changed,
+ -- or there's some useful occurrence information
-- See the notes with substTyVarBndr for the delSubstEnv
new_subst | new_id /= old_id
- = extendVarEnv id_subst old_id (DoneId new_id (idOccInfo old_id))
+ = extendVarEnv id_subst old_id (DoneId new_id)
| otherwise
= delVarEnv id_subst old_id
\end{code}
-
\begin{code}
+------------------------------------
seqTyVar :: TyVar -> ()
seqTyVar b = b `seq` ()
\end{code}
-%************************************************************************
-%* *
- Let bindings
-%* *
-%************************************************************************
-
-Simplifying let binders
+Note [Arity robustness]
~~~~~~~~~~~~~~~~~~~~~~~
-Rename the binders if necessary,
-
-\begin{code}
-simplNonRecBndr :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
-simplNonRecBndr env id
- = do { let (env1, id1) = substLetIdBndr env id
- ; seqId id1 `seq` return (env1, id1) }
-
----------------
-simplRecBndrs :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
-simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
- = do { let (env1, ids1) = mapAccumL substLetIdBndr env ids
- ; seqIds ids1 `seq` return (env1, ids1) }
-
----------------
-substLetIdBndr :: SimplEnv -> InBinder -- Env and binder to transform
- -> (SimplEnv, OutBinder)
--- C.f. CoreSubst.substIdBndr
--- Clone Id if necessary, substitute its type
--- Return an Id with completely zapped IdInfo
--- [addLetIdInfo, below, will restore its IdInfo]
--- Augment the subtitution
--- if the unique changed, *or*
--- if there's interesting occurrence info
-
-substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
- = (env { seInScope = in_scope `extendInScopeSet` new_id,
- seIdSubst = new_subst }, new_id)
- where
- id1 = uniqAway in_scope old_id
- id2 = substIdType env id1
- new_id = setIdInfo id2 vanillaIdInfo
-
- -- Extend the substitution if the unique has changed,
- -- or there's some useful occurrence information
- -- See the notes with substTyVarBndr for the delSubstEnv
- occ_info = occInfo (idInfo old_id)
- new_subst | new_id /= old_id || isFragileOcc occ_info
- = extendVarEnv id_subst old_id (DoneId new_id occ_info)
- | otherwise
- = delVarEnv id_subst old_id
-\end{code}
-
-Add IdInfo back onto a let-bound Id
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We must transfer the IdInfo of the original binder to the new binder.
-This is crucial, to preserve
- strictness
- rules
- worker info
-etc. To do this we must apply the current substitution,
-which incorporates earlier substitutions in this very letrec group.
-
-NB 1. We do this *before* processing the RHS of the binder, so that
-its substituted rules are visible in its own RHS.
-This is important. Manuel found cases where he really, really
-wanted a RULE for a recursive function to apply in that function's
-own right-hand side.
-
-NB 2: ARITY. We *do* transfer the arity. This is important, so that
-the arity of an Id is visible in its own RHS. For example:
+We *do* transfer the arity from from the in_id of a let binding to the
+out_id. This is important, so that the arity of an Id is visible in
+its own RHS. For example:
f = \x. ....g (\y. f y)....
We can eta-reduce the arg to g, becuase f is a value. But that
needs to be visible.
take advantage of the 'state hack' on the result of
(f y) :: State# -> (State#, Int) to expand the arity one more.
-There is a disadvantage though. Making the arity visible in the RHA
+There is a disadvantage though. Making the arity visible in the RHS
allows us to eta-reduce
f = \x -> f x
to
never decreases; its arity started as 1, and we should never eta-reduce
below that.
-NB 3: OccInfo. It's important that we *do* transer the loop-breaker
-OccInfo, because that's what stops the Id getting inlined infinitely,
-in the body of the letrec.
-NB 4: does no harm for non-recursive bindings
+Note [Robust OccInfo]
+~~~~~~~~~~~~~~~~~~~~~
+It's important that we *do* retain the loop-breaker OccInfo, because
+that's what stops the Id getting inlined infinitely, in the body of
+the letrec.
-NB 5: we can't do the addLetIdInfo part before *all* the RHSs because
- rec { f = g
- h = ...
- RULE h Int = f
- }
-Here, we'll do postInlineUnconditionally on f, and we must "see" that
-when substituting in h's RULE.
-\begin{code}
-addLetIdInfo :: SimplEnv -> InBinder -> OutBinder -> (SimplEnv, OutBinder)
-addLetIdInfo env in_id out_id
- = (modifyInScope env out_id final_id, final_id)
- where
- final_id = out_id `setIdInfo` new_info
- subst = mkCoreSubst env
- old_info = idInfo in_id
- new_info = case substIdInfo subst old_info of
- Nothing -> old_info
- Just new_info -> new_info
-
-substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
--- Substitute the
--- rules
--- worker info
--- Zap the unfolding
--- Keep only 'robust' OccInfo
--- arity
---
--- Seq'ing on the returned IdInfo is enough to cause all the
--- substitutions to happen completely
-
-substIdInfo subst info
- | nothing_to_do = Nothing
- | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
- `setSpecInfo` CoreSubst.substSpec subst old_rules
- `setWorkerInfo` CoreSubst.substWorker subst old_wrkr
- `setUnfoldingInfo` noUnfolding)
- -- setSpecInfo does a seq
- -- setWorkerInfo does a seq
- where
- nothing_to_do = keep_occ &&
- isEmptySpecInfo old_rules &&
- not (workerExists old_wrkr) &&
- not (hasUnfolding (unfoldingInfo info))
-
- keep_occ = not (isFragileOcc old_occ)
- old_arity = arityInfo info
- old_occ = occInfo info
- old_rules = specInfo info
- old_wrkr = workerInfo info
+Note [Rules in a letrec]
+~~~~~~~~~~~~~~~~~~~~~~~~
+After creating fresh binders for the binders of a letrec, we
+substitute the RULES and add them back onto the binders; this is done
+*before* processing any of the RHSs. This is important. Manuel found
+cases where he really, really wanted a RULE for a recursive function
+to apply in that function's own right-hand side.
-------------------
-substIdType :: SimplEnv -> Id -> Id
-substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
- | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
- | otherwise = 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
+See Note [Loop breaking and RULES] in OccAnal.
-------------------
-substUnfolding env NoUnfolding = NoUnfolding
-substUnfolding env (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
+
+\begin{code}
+addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
+-- Rules are added back in to to the bin
+addBndrRules env in_id out_id
+ | isEmptySpecInfo old_rules = (env, out_id)
+ | otherwise = (modifyInScope env final_id, final_id)
+ where
+ subst = mkCoreSubst (text "local rules") env
+ old_rules = idSpecialisation in_id
+ new_rules = CoreSubst.substSpec subst out_id old_rules
+ final_id = out_id `setIdSpecialisation` new_rules
\end{code}
%************************************************************************
\begin{code}
+getTvSubst :: SimplEnv -> TvSubst
+getTvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env })
+ = mkTvSubst in_scope tv_env
+
+getCvSubst :: SimplEnv -> CvSubst
+getCvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env })
+ = CvSubst in_scope tv_env cv_env
+
substTy :: SimplEnv -> Type -> Type
-substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
- = Type.substTy (TvSubst in_scope tv_env) ty
+substTy env ty = Type.substTy (getTvSubst env) ty
+
+substTyVar :: SimplEnv -> TyVar -> Type
+substTyVar env tv = Type.substTyVar (getTvSubst env) tv
substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
-substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
- = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
+substTyVarBndr env tv
+ = case Type.substTyVarBndr (getTvSubst env) tv of
(TvSubst in_scope' tv_env', tv')
- -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
+ -> (env { seInScope = in_scope', seTvSubst = tv_env' }, tv')
+
+substCoVar :: SimplEnv -> CoVar -> Coercion
+substCoVar env tv = Coercion.substCoVar (getCvSubst env) tv
+
+substCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar)
+substCoVarBndr env cv
+ = case Coercion.substCoVarBndr (getCvSubst env) cv of
+ (CvSubst in_scope' tv_env' cv_env', cv')
+ -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, cv')
+
+substCo :: SimplEnv -> Coercion -> Coercion
+substCo env co = Coercion.substCo (getCvSubst env) co
-- When substituting in rules etc we can get CoreSubst to do the work
-- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
-- here. I think the this will not usually result in a lot of work;
-- the substitutions are typically small, and laziness will avoid work in many cases.
-mkCoreSubst :: SimplEnv -> CoreSubst.Subst
-mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
- = mk_subst tv_env id_env
+mkCoreSubst :: SDoc -> SimplEnv -> CoreSubst.Subst
+mkCoreSubst doc (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env, seIdSubst = id_env })
+ = mk_subst tv_env cv_env id_env
where
- mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
+ mk_subst tv_env cv_env id_env = CoreSubst.mkSubst in_scope tv_env cv_env (mapVarEnv fiddle id_env)
- fiddle (DoneEx e) = e
- fiddle (DoneId v occ) = Var v
- 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
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Floats}
-%* *
-%************************************************************************
-
-\begin{code}
-type FloatsWithExpr = FloatsWith OutExpr
-type FloatsWith a = (Floats, a)
- -- We return something equivalent to (let b in e), but
- -- in pieces to avoid the quadratic blowup when floating
- -- incrementally. Comments just before simplExprB in Simplify.lhs
+ fiddle (DoneEx e) = e
+ fiddle (DoneId v) = Var v
+ fiddle (ContEx tv cv id e) = CoreSubst.substExpr (text "mkCoreSubst" <+> doc) (mk_subst tv cv id) e
+ -- Don't shortcut here
-data Floats = Floats (OrdList OutBind)
- InScopeSet -- Environment "inside" all the floats
- Bool -- True <=> All bindings are lifted
-
-allLifted :: Floats -> Bool
-allLifted (Floats _ _ is_lifted) = is_lifted
-
-wrapFloats :: Floats -> OutExpr -> OutExpr
-wrapFloats (Floats bs _ _) body = foldrOL Let body bs
-
-isEmptyFloats :: Floats -> Bool
-isEmptyFloats (Floats bs _ _) = isNilOL bs
-
-floatBinds :: Floats -> [OutBind]
-floatBinds (Floats bs _ _) = fromOL bs
-
-flattenFloats :: Floats -> Floats
--- Flattens into a single Rec group
-flattenFloats (Floats bs is is_lifted)
- = ASSERT2( is_lifted, ppr (fromOL bs) )
- Floats (unitOL (Rec (flattenBinds (fromOL bs)))) is is_lifted
-\end{code}
+------------------
+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
-\begin{code}
-emptyFloats :: SimplEnv -> Floats
-emptyFloats env = Floats nilOL (getInScope env) True
-
-unitFloat :: SimplEnv -> OutId -> OutExpr -> Floats
--- A single non-rec float; extend the in-scope set
-unitFloat env var rhs = Floats (unitOL (NonRec var rhs))
- (extendInScopeSet (getInScope env) var)
- (not (isUnLiftedType (idType var)))
-
-addFloats :: SimplEnv -> Floats
- -> (SimplEnv -> SimplM (FloatsWith a))
- -> SimplM (FloatsWith a)
-addFloats env (Floats b1 is1 l1) thing_inside
- | isNilOL b1
- = thing_inside env
- | otherwise
- = thing_inside (setInScopeSet env is1) `thenSmpl` \ (Floats b2 is2 l2, res) ->
- returnSmpl (Floats (b1 `appOL` b2) is2 (l1 && l2), res)
-
-addLetBind :: OutBind -> Floats -> Floats
-addLetBind bind (Floats binds in_scope lifted)
- = Floats (bind `consOL` binds) in_scope (lifted && is_lifted_bind bind)
-
-is_lifted_bind (Rec _) = True
-is_lifted_bind (NonRec b r) = not (isUnLiftedType (idType b))
-
--- addAuxiliaryBind * takes already-simplified things (bndr and rhs)
--- * extends the in-scope env
--- * assumes it's a let-bindable thing
-addAuxiliaryBind :: SimplEnv -> OutBind
- -> (SimplEnv -> SimplM (FloatsWith a))
- -> SimplM (FloatsWith a)
- -- Extends the in-scope environment as well as wrapping the bindings
-addAuxiliaryBind env bind thing_inside
- = ASSERT( case bind of { NonRec b r -> not (needsCaseBinding (idType b) r) ; Rec _ -> True } )
- thing_inside (addNewInScopeIds env (bindersOf bind)) `thenSmpl` \ (floats, x) ->
- returnSmpl (addLetBind bind floats, x)
+------------------
+substExpr :: SDoc -> SimplEnv -> CoreExpr -> CoreExpr
+substExpr doc env
+ = CoreSubst.substExpr (text "SimplEnv.substExpr1" <+> doc)
+ (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env)
+ -- Do *not* short-cut in the case of an empty substitution
+ -- See Note [SimplEnv invariants]
+
+substUnfolding :: SimplEnv -> Unfolding -> Unfolding
+substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst (text "subst-unfolding") env) unf
+ -- Do *not* short-cut in the case of an empty substitution
+ -- See Note [SimplEnv invariants]
\end{code}
-
projects / ghc-hetmet.git / blobdiff