X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFamInstEnv.lhs;h=ba96a55e45fc695e95aec52c4f3b8646a6535cc2;hb=1ae354e107715a9e3fd4e2d67b61f868c090e4ae;hp=f442e02995d94310ed62fafd98442b13e6112caa;hpb=f7c8513de81ccb1bca62a8e4642926f19266845b;p=ghc-hetmet.git diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index f442e02..ba96a55 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -24,8 +24,6 @@ module FamInstEnv ( import InstEnv import Unify -import TcGadt -import TcType import Type import TypeRep import TyCon @@ -37,6 +35,7 @@ import UniqFM import Outputable import Maybes import Util +import FastString import Maybe \end{code} @@ -88,16 +87,16 @@ instance Outputable FamInst where pprFamInst :: FamInst -> SDoc pprFamInst famInst = hang (pprFamInstHdr famInst) - 2 (ptext SLIT("--") <+> pprNameLoc (getName famInst)) + 2 (ptext (sLit "--") <+> pprNameLoc (getName famInst)) pprFamInstHdr :: FamInst -> SDoc pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon}) = pprTyConSort <+> pprHead where - pprHead = pprTypeApp fam (ppr fam) tys - pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance") - | isNewTyCon tycon = ptext SLIT("newtype instance") - | isSynTyCon tycon = ptext SLIT("type instance") + pprHead = pprTypeApp fam tys + pprTyConSort | isDataTyCon tycon = ptext (sLit "data instance") + | isNewTyCon tycon = ptext (sLit "newtype instance") + | isSynTyCon tycon = ptext (sLit "type instance") | otherwise = panic "FamInstEnv.pprFamInstHdr" pprFamInsts :: [FamInst] -> SDoc @@ -314,17 +313,11 @@ lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys ) -- Unification will break badly if the variables overlap -- They shouldn't because we allocate separate uniques for them - case tcUnifyTys bind_fn tpl_tys tys of + case tcUnifyTys instanceBindFun tpl_tys tys of Just subst -> let rep_tys = substTyVars subst (tyConTyVars tycon) in ((item, rep_tys), subst) : find rest Nothing -> find rest - --- See explanation at @InstEnv.bind_fn@. --- -bind_fn :: TyVar -> BindFlag -bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem - | otherwise = BindMe \end{code} %************************************************************************ @@ -428,9 +421,6 @@ normaliseType env (FunTy ty1 ty2) normaliseType env (ForAllTy tyvar ty1) = let (coi,nty1) = normaliseType env ty1 in (mkForAllTyCoI tyvar coi,ForAllTy tyvar nty1) -normaliseType env (NoteTy note ty1) - = let (coi,nty1) = normaliseType env ty1 - in (coi,NoteTy note nty1) normaliseType _ ty@(TyVarTy _) = (IdCo,ty) normaliseType env (PredTy predty)