Repository : ssh://g...@git.haskell.org/ghc
On branch : master
Link :
http://ghc.haskell.org/trac/ghc/changeset/67ede55dcc8cbb225172d2b688b335bae81e20a1/ghc
>---------------------------------------------------------------
commit 67ede55dcc8cbb225172d2b688b335bae81e20a1
Author: Simon Peyton Jones <simo...@microsoft.com>
Date: Tue Oct 8 18:07:37 2013 +0100
Print (non-representational) roles when display TyCon information
>---------------------------------------------------------------
67ede55dcc8cbb225172d2b688b335bae81e20a1
compiler/main/PprTyThing.hs | 39 +++++++++++++++++++++++++--------------
1 file changed, 25 insertions(+), 14 deletions(-)
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index d8cbc07..1f458f0 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
_______________________________________________
ghc-commits mailing list
ghc-commits@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-commits
