2 (ptext (sLit "--") <+> pprNameLoc (getName famInst))
pprFamInstHdr :: FamInst -> SDoc
-pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
- = pprTyConSort <+> pprHead
+pprFamInstHdr (FamInst {fi_tycon = rep_tc})
+ = pprTyConSort <+> pp_instance <+> pprHead
where
- pprHead = pprTypeApp fam tys
- pprTyConSort | isDataTyCon tycon = ptext (sLit "data instance")
- | isNewTyCon tycon = ptext (sLit "newtype instance")
- | isSynTyCon tycon = ptext (sLit "type instance")
- | isAbstractTyCon tycon = ptext (sLit "data instance")
- | otherwise = panic "FamInstEnv.pprFamInstHdr"
+ Just (fam_tc, tys) = tyConFamInst_maybe rep_tc
+
+ -- For *associated* types, say "type T Int = blah"
+ -- For *top level* type instances, say "type instance T Int = blah"
+ pp_instance
+ | isTyConAssoc fam_tc = empty
+ | otherwise = ptext (sLit "instance")
+
+ pprHead = pprTypeApp fam_tc tys
+ pprTyConSort | isDataTyCon rep_tc = ptext (sLit "data")
+ | isNewTyCon rep_tc = ptext (sLit "newtype")
+ | isSynTyCon rep_tc = ptext (sLit "type")
+ | isAbstractTyCon rep_tc = ptext (sLit "data")
+ | otherwise = panic "FamInstEnv.pprFamInstHdr"
pprFamInsts :: [FamInst] -> SDoc
pprFamInsts finsts = vcat (map pprFamInst finsts)
normaliseType env (AppTy ty1 ty2)
= let (coi1,nty1) = normaliseType env ty1
(coi2,nty2) = normaliseType env ty2
- in (mkAppTyCoI coi1 coi2, AppTy nty1 nty2)
+ in (mkAppTyCoI coi1 coi2, mkAppTy nty1 nty2)
normaliseType env (FunTy ty1 ty2)
= let (coi1,nty1) = normaliseType env ty1
(coi2,nty2) = normaliseType env ty2
- in (mkFunTyCoI coi1 coi2, FunTy nty1 nty2)
+ in (mkFunTyCoI coi1 coi2, mkFunTy nty1 nty2)
normaliseType env (ForAllTy tyvar ty1)
= let (coi,nty1) = normaliseType env ty1
in (mkForAllTyCoI tyvar coi, ForAllTy tyvar nty1)