diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-04 18:42:04 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-10-04 18:42:04 +0100 |
| commit | da46a00562c5235ab63d9049aae5cf5c93a45adb (patch) | |
| tree | 9ddb55f4a9b0f42eb7e4d98232809b17d156b9da /compiler/iface/IfaceSyn.lhs | |
| parent | a9649c48681054d86b6a1e33118aa12903a4fbfd (diff) | |
| download | haskell-da46a00562c5235ab63d9049aae5cf5c93a45adb.tar.gz | |
Improve pretty-printing of IfaceSyn type families
Diffstat (limited to 'compiler/iface/IfaceSyn.lhs')
| -rw-r--r-- | compiler/iface/IfaceSyn.lhs | 29 |
1 files changed, 14 insertions, 15 deletions
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 28098aed78..9088c2e5bd 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -282,7 +282,7 @@ pprAxBranch mtycon (IfaceAxBranch { ifaxbTyVars = tvs , ifaxbRHS = ty , ifaxbIncomps = incomps }) = ppr tvs <+> ppr_lhs <+> char '=' <+> ppr ty $+$ - nest 4 maybe_incomps + nest 2 maybe_incomps where ppr_lhs | Just tycon <- mtycon @@ -1018,18 +1018,17 @@ pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = IfaceSynonymTyCon mono_ty}) = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars) - 4 (vcat [equals <+> ppr mono_ty]) + 2 (vcat [equals <+> ppr mono_ty]) pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, - ifSynRhs = IfaceOpenSynFamilyTyCon, ifSynKind = kind }) + ifSynRhs = rhs, ifSynKind = kind }) = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars) - 4 (dcolon <+> ppr kind) - --- this case handles both abstract and instantiated closed family tycons -pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, - ifSynRhs = _closedSynFamilyTyCon, ifSynKind = kind }) - = hang (ptext (sLit "closed type family") <+> pprIfaceDeclHead [] tycon tyvars) - 4 (dcolon <+> ppr kind) + 2 (sep [dcolon <+> ppr kind, parens (pp_rhs rhs)]) + where + pp_rhs IfaceOpenSynFamilyTyCon = ptext (sLit "open") + pp_rhs (IfaceClosedSynFamilyTyCon ax) = ptext (sLit "closed, axiom") <+> ppr ax + pp_rhs IfaceAbstractClosedSynFamilyTyCon = ptext (sLit "closed, abstract") + pp_rhs _ = panic "pprIfaceDecl syn" pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType, ifCtxt = context, @@ -1037,9 +1036,9 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType, ifRec = isrec, ifPromotable = is_prom, ifAxiom = mbAxiom}) = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars) - 4 (vcat [ pprCType cType + 2 (vcat [ pprCType cType , pprRoles roles - , pprRec isrec <> comma <+> pp_prom + , pprRec isrec <> comma <+> pp_prom , pp_condecls tycon condecls , pprAxiom mbAxiom]) where @@ -1055,7 +1054,7 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, ifRoles = roles, ifFDs = fds, ifATs = ats, ifSigs = sigs, ifRec = isrec}) = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds) - 4 (vcat [pprRoles roles, + 2 (vcat [pprRoles roles, pprRec isrec, sep (map ppr ats), sep (map ppr sigs)]) @@ -1111,9 +1110,9 @@ pprIfaceConDecl tc if is_infix then ptext (sLit "Infix") else empty, if has_wrap then ptext (sLit "HasWrapper") else empty, ppUnless (null strs) $ - nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)), + nest 2 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)), ppUnless (null fields) $ - nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))] + nest 2 (ptext (sLit "Fields:") <+> hsep (map ppr fields))] where ppr_bang IfNoBang = char '_' -- Want to see these ppr_bang IfStrict = char '!' |