%
-% (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, InBndr,
- OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
+ InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar,
+ OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar,
InCoercion, OutCoercion,
-- 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,
simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
simplBinder, simplBinders, addBndrRules,
- substExpr, substTy, getTvSubst, mkCoreSubst,
+ substExpr, substTy, substTyVar, getTvSubst, mkCoreSubst,
-- Floats
Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
import VarSet
import OrdList
import Id
-import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substUnfolding )
-import qualified Type ( substTy, substTyVarBndr )
-import Type hiding ( substTy, substTyVarBndr )
+import MkCore
+import TysWiredIn
+import qualified CoreSubst
+import qualified Type ( substTy, substTyVarBndr, substTyVar )
+import Type hiding ( substTy, substTyVarBndr, substTyVar )
import Coercion
import BasicTypes
import MonadUtils
\begin{code}
type InBndr = CoreBndr
+type InVar = Var -- Not yet cloned
type InId = Id -- Not yet cloned
type InType = Type -- Ditto
type InBind = CoreBind
type InCoercion = Coercion
type OutBndr = CoreBndr
+type OutVar = Var -- Cloned
type OutId = Id -- Cloned
type OutTyVar = TyVar -- Cloned
type OutType = Type -- Cloned
-- 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
-- Used for debugging; selective
pprSimplEnv env
= vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
- ptext (sLit "IdSubst:") <+> ppr (seIdSubst 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
-- 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
* 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.
\begin{code}
-mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
-mkSimplEnv switches mode
- = SimplEnv { seChkr = switches, seCC = subsumedCCS,
- seMode = mode, seInScope = emptyInScopeSet,
- seFloats = emptyFloats,
- seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
+mkSimplEnv :: SimplifierMode -> SimplEnv
+mkSimplEnv mode
+ = SimplEnv { seCC = subsumedCCS
+ , seMode = mode
+ , seInScope = init_in_scope
+ , seFloats = emptyFloats
+ , seTvSubst = 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
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
-- in-scope set (although it might also have been created with newId)
-- but it may now have more IdInfo
addNonRec env id rhs
- = env { seFloats = seFloats env `addFlts` unitFloat (NonRec 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
-- The substitution is extended only if the variable is cloned, because
-- we *don't* need to use it to track occurrence info.
simplBinder env bndr
- | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
+ | isTyCoVar bndr = do { let (env', tv) = substTyVarBndr env bndr
; seqTyVar tv `seq` return (env', tv) }
| otherwise = do { let (env', id) = substIdBndr env bndr
; seqId id `seq` return (env', id) }
| isEmptySpecInfo old_rules = (env, out_id)
| otherwise = (modifyInScope env final_id, final_id)
where
- subst = mkCoreSubst env
+ 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
substTy :: SimplEnv -> Type -> Type
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 tv
= case Type.substTyVarBndr (getTvSubst env) tv of
-- 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 })
+mkCoreSubst :: SDoc -> SimplEnv -> CoreSubst.Subst
+mkCoreSubst doc (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
= mk_subst tv_env id_env
where
mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
fiddle (DoneEx e) = e
fiddle (DoneId v) = Var v
- fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
+ fiddle (ContEx tv id e) = CoreSubst.substExpr (text "mkCoreSubst" <+> doc) (mk_subst tv id) e
+ -- Don't shortcut here
------------------
substIdType :: SimplEnv -> Id -> Id
old_ty = idType id
------------------
-substExpr :: SimplEnv -> CoreExpr -> CoreExpr
-substExpr env expr = CoreSubst.substExpr (mkCoreSubst env) expr
+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 CoreSubst: Note [Extending the Subst]
+ -- See Note [SimplEnv invariants]
substUnfolding :: SimplEnv -> Unfolding -> Unfolding
-substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst env) unf
+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