diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-08 18:07:37 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-08 18:07:37 +0100 |
| commit | 67ede55dcc8cbb225172d2b688b335bae81e20a1 (patch) | |
| tree | 3cf86c6a886f0f25f43428878e91b052e70eca06 /compiler/main/PprTyThing.hs | |
| parent | d42b0ec6f6a6ca7603c64b29a965d6704fc13d11 (diff) | |
| download | haskell-67ede55dcc8cbb225172d2b688b335bae81e20a1.tar.gz | |
Print (non-representational) roles when display TyCon information
Diffstat (limited to 'compiler/main/PprTyThing.hs')
| -rw-r--r-- | compiler/main/PprTyThing.hs | 39 |
1 files changed, 25 insertions, 14 deletions
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index d8cbc07b98..1f458f0d70 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -181,27 +181,38 @@ pprTyCon :: ShowSub -> TyCon -> SDoc pprTyCon ss tyCon | Just syn_rhs <- synTyConRhs_maybe tyCon = case syn_rhs of - OpenSynFamilyTyCon -> pprTyConHdr tyCon <+> dcolon <+> - pprTypeForUser (synTyConResKind tyCon) - ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) -> - hang closed_family_header - 2 (vcat (brListMap (pprCoAxBranch tyCon) branches)) - AbstractClosedSynFamilyTyCon -> closed_family_header <+> ptext (sLit "..") - SynonymTyCon rhs_ty -> hang (pprTyConHdr tyCon <+> equals) - 2 (ppr rhs_ty) -- Don't suppress foralls on RHS type! - BuiltInSynFamTyCon {} -> pprTyConHdr tyCon <+> dcolon <+> - pprTypeForUser (synTyConResKind tyCon) + OpenSynFamilyTyCon -> pp_tc_with_kind + BuiltInSynFamTyCon {} -> pp_tc_with_kind + + ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) + -> hang closed_family_header + 2 (vcat (brListMap (pprCoAxBranch tyCon) branches)) + + AbstractClosedSynFamilyTyCon + -> closed_family_header <+> ptext (sLit "..") + + SynonymTyCon rhs_ty + -> hang (pprTyConHdr tyCon <+> equals) + 2 (ppr rhs_ty) -- Don't suppress foralls on RHS type! -- e.g. type T = forall a. a->a | Just cls <- tyConClass_maybe tyCon - = pprClass ss cls + = pp_roles $$ pprClass ss cls + | otherwise - = pprAlgTyCon ss tyCon + = pp_roles $$ pprAlgTyCon ss tyCon where + pp_roles = sdocWithDynFlags $ \dflags -> + let roles = suppressKinds dflags (tyConKind tyCon) (tyConRoles tyCon) + in ppUnless (all (== Representational) roles) $ + ptext (sLit "type role") <+> ppr tyCon <+> hsep (map ppr roles) + + pp_tc_with_kind = vcat [ pp_roles + , pprTyConHdr tyCon <+> dcolon + <+> pprTypeForUser (synTyConResKind tyCon) ] closed_family_header - = pprTyConHdr tyCon <+> dcolon <+> - pprTypeForUser (synTyConResKind tyCon) <+> ptext (sLit "where") + = pp_tc_with_kind <+> ptext (sLit "where") pprAlgTyCon :: ShowSub -> TyCon -> SDoc pprAlgTyCon ss tyCon |