X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPprTyThing.hs;h=4d7fd8ec52fb97d6e789a348a4719688bb690070;hb=311b1cdfc9b1c311cc53482c461c18cba8885b2a;hp=63549841596b2fdb7494fd11a215833fa2580cb7;hpb=2a6d497b719b39d7d7d73051f3baa783db343abb;p=ghc-hetmet.git diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index 6354984..4d7fd8e 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -67,7 +67,7 @@ pprTyThingHdr exts (ATyCon tyCon) = pprTyConHdr exts tyCon pprTyThingHdr exts (AClass cls) = pprClassHdr exts cls pprTyConHdr exts tyCon = - ptext keyword <+> ppr_bndr tyCon <+> hsep (map ppr vars) + addFamily (ptext keyword) <+> ppr_bndr tyCon <+> hsep (map ppr vars) where vars | GHC.isPrimTyCon tyCon || GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars @@ -77,6 +77,10 @@ pprTyConHdr exts tyCon = | GHC.isNewTyCon tyCon = SLIT("newtype") | otherwise = SLIT("data") + addFamily keytext + | GHC.isOpenTyCon tyCon = keytext <> ptext SLIT(" family") + | otherwise = keytext + pprDataConSig exts dataCon = ppr_bndr dataCon <+> dcolon <+> pprType exts (GHC.dataConType dataCon) @@ -109,8 +113,12 @@ pprType False ty = ppr (GHC.dropForAlls ty) pprTyCon exts tyCon | GHC.isSynTyCon tyCon - = let rhs_type = GHC.synTyConRhs tyCon - in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type) + = if GHC.isOpenTyCon tyCon + then pprTyConHdr exts tyCon <+> dcolon <+> + pprType exts (GHC.synTyConResKind tyCon) + else + let rhs_type = GHC.synTyConType tyCon + in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type) | otherwise = pprAlgTyCon exts tyCon (const True) (const True)