[commit: ghc] master: Improve pretty-printing of IfaceSyn type families (da46a00)

[git at git.haskell.org]

Repository : ssh://git at git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/da46a00562c5235ab63d9049aae5cf5c93a45adb/ghc

>---------------------------------------------------------------

commit da46a00562c5235ab63d9049aae5cf5c93a45adb
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Oct 4 18:42:04 2013 +0100

    Improve pretty-printing of IfaceSyn type families


>---------------------------------------------------------------

da46a00562c5235ab63d9049aae5cf5c93a45adb
 compiler/iface/IfaceSyn.lhs |   27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 28098ae..9088c2e 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,7 +1036,7 @@ 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
                , pp_condecls tycon condecls
@@ -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 '!'