- ppr (Subst (InScope in_scope _) se)
- = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (rngVarEnv in_scope)))
- $$ ptext SLIT(" Subst =") <+> ppr se <> char '>'
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Type substitution}
-%* *
-%************************************************************************
-
-\begin{code}
-type TyVarSubst = Subst -- TyVarSubst are expected to have range elements
- -- (We could have a variant of Subst, but it doesn't seem worth it.)
-
--- mkTyVarSubst generates the in-scope set from
--- the types given; but it's just a thunk so with a bit of luck
--- it'll never be evaluated
-mkTyVarSubst :: [TyVar] -> [Type] -> Subst
-mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys))
- (zip_ty_env tyvars tys emptySubstEnv)
-
--- mkTopTyVarSubst is called when doing top-level substitutions.
--- Here we expect that the free vars of the range of the
--- substitution will be empty.
-mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
-mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
-
-zip_ty_env [] [] env = env
-zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
- -- There used to be a special case for when
- -- ty == TyVarTy tv
- -- (a not-uncommon case) in which case the substitution was dropped.
- -- But the type-tidier changes the print-name of a type variable without
- -- changing the unique, and that led to a bug. Why? Pre-tidying, we had
- -- a type {Foo t}, where Foo is a one-method class. So Foo is really a newtype.
- -- And it happened that t was the type variable of the class. Post-tiding,
- -- it got turned into {Foo t2}. The ext-core printer expanded this using
- -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
- -- and so generated a rep type mentioning t not t2.
- --
- -- Simplest fix is to nuke the "optimisation"
-\end{code}
-
-substTy works with general Substs, so that it can be called from substExpr too.
-
-\begin{code}
-substTyWith :: [TyVar] -> [Type] -> Type -> Type
-substTyWith tvs tys = substTy (mkTyVarSubst tvs tys)
-
-substTy :: Subst -> Type -> Type
-substTy subst ty | isEmptySubst subst = ty
- | otherwise = subst_ty subst ty
-
-substTheta :: TyVarSubst -> ThetaType -> ThetaType
-substTheta subst theta
- | isEmptySubst subst = theta
- | otherwise = map (substPred subst) theta
-
-substPred :: TyVarSubst -> PredType -> PredType
-substPred = substSourceType
-
-substSourceType subst (IParam n ty) = IParam n (subst_ty subst ty)
-substSourceType subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
-substSourceType subst (NType tc tys) = NType tc (map (subst_ty subst) tys)
-
-subst_ty subst ty
- = go ty
- where
- go (TyConApp tc tys) = let args = map go tys
- in args `seqList` TyConApp tc args
-
- go (SourceTy p) = SourceTy $! (substSourceType subst p)
-
- go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2)
- go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
-
- go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
- go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
- go ty@(TyVarTy tv) = case (lookupSubst subst tv) of
- Nothing -> ty
- Just (DoneTy ty') -> ty'
-
- go (ForAllTy tv ty) = case substTyVar subst tv of
- (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
-
- go (UsageTy u ty) = mkUTy (go u) $! (go ty)
-\end{code}
-
-Here is where we invent a new binder if necessary.
-
-\begin{code}
-substTyVar :: Subst -> TyVar -> (Subst, TyVar)
-substTyVar subst@(Subst in_scope env) old_var
- | old_var == new_var -- No need to clone
- -- But we *must* zap any current substitution for the variable.
- -- For example:
- -- (\x.e) with id_subst = [x |-> e']
- -- Here we must simply zap the substitution for x
- --
- -- The new_id isn't cloned, but it may have a different type
- -- etc, so we must return it, not the old id
- = (Subst (in_scope `extendInScopeSet` new_var)
- (delSubstEnv env old_var),
- new_var)
-
- | otherwise -- The new binder is in scope so
- -- we'd better rename it away from the in-scope variables
- -- Extending the substitution to do this renaming also
- -- has the (correct) effect of discarding any existing
- -- substitution for that variable
- = (Subst (in_scope `extendInScopeSet` new_var)
- (extendSubstEnv env old_var (DoneTy (TyVarTy new_var))),
- new_var)
- where
- new_var = uniqAway in_scope old_var
- -- The uniqAway part makes sure the new variable is not already in scope