Utility functions on @Core@ syntax
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module CoreSubst (
-- Substitution stuff
Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
import Maybes
import Outputable
import PprCore () -- Instances
-import Util
-import FastTypes
+import FastString
import Data.List
\end{code}
extendSubstList subst [] = subst
extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs
+extendSubst :: Subst -> Var -> CoreArg -> Subst
extendSubst (Subst in_scope ids tvs) tv (Type ty)
= ASSERT( isTyVar tv ) Subst in_scope ids (extendVarEnv tvs tv ty)
extendSubst (Subst in_scope ids tvs) id expr
= ASSERT( isId id ) Subst in_scope (extendVarEnv ids id expr) tvs
lookupIdSubst :: Subst -> Id -> CoreExpr
-lookupIdSubst (Subst in_scope ids tvs) v
+lookupIdSubst (Subst in_scope ids _) v
| not (isLocalId v) = Var v
| Just e <- lookupVarEnv ids v = e
| Just v' <- lookupInScope in_scope v = Var v'
-- Vital! See Note [Extending the Subst]
- | otherwise = WARN( True, ptext SLIT("CoreSubst.lookupIdSubst") <+> ppr v )
+ | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v )
Var v
lookupTvSubst :: Subst -> TyVar -> Type
-lookupTvSubst (Subst _ ids tvs) v = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v
+lookupTvSubst (Subst _ _ tvs) v = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v
------------------------------
isInScope :: Var -> Subst -> Bool
\begin{code}
instance Outputable Subst where
ppr (Subst in_scope ids tvs)
- = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
- $$ ptext SLIT(" IdSubst =") <+> ppr ids
- $$ ptext SLIT(" TvSubst =") <+> ppr tvs
+ = ptext (sLit "<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
+ $$ ptext (sLit " IdSubst =") <+> ppr ids
+ $$ ptext (sLit " TvSubst =") <+> ppr tvs
<> char '>'
\end{code}
-> (Subst in_scope' id_env tv_env', tv')
substTy :: Subst -> Type -> Type
-substTy (Subst in_scope id_env tv_env) ty
+substTy (Subst in_scope _id_env tv_env) ty
= Type.substTy (TvSubst in_scope tv_env) ty
\end{code}
\begin{code}
substIdType :: Subst -> Id -> Id
-substIdType subst@(Subst in_scope id_env tv_env) id
+substIdType subst@(Subst _ _ tv_env) id
| isEmptyVarEnv tv_env || isEmptyVarSet (Type.tyVarsOfType old_ty) = id
| otherwise = setIdType id (substTy subst old_ty)
-- The tyVarsOfType is cheaper than it looks
-- Seq'ing on the returned WorkerInfo is enough to cause all the
-- substitutions to happen completely
-substWorker subst NoWorker
+substWorker _ NoWorker
= NoWorker
substWorker subst (HasWorker w a)
= case lookupIdSubst subst w of
(subst', bndrs') = substBndrs subst bndrs
------------------
+substVarSet :: Subst -> VarSet -> VarSet
substVarSet subst fvs
= foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
where