Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9b9f197b05c4bf9d16289d3aa6e71e9f081da7f6 >--------------------------------------------------------------- commit 9b9f197b05c4bf9d16289d3aa6e71e9f081da7f6 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Jan 2 12:37:07 2013 +0000 Improve HsSyn pretty-printing of instance declarations (fixes Trac #7532) >--------------------------------------------------------------- compiler/hsSyn/HsDecls.lhs | 42 +++++++++++++++++++++++++++--------------- 1 files changed, 27 insertions(+), 15 deletions(-) diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 05af165..bd007a8 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -755,8 +755,8 @@ pp_data_defn :: OutputableBndr name -> HsDataDefn name -> SDoc pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context - , dd_kindSig = mb_sig - , dd_cons = condecls, dd_derivs = derivings }) + , dd_kindSig = mb_sig + , dd_cons = condecls, dd_derivs = derivings }) | null condecls = ppr new_or_data <+> pp_hdr context <+> pp_sig @@ -921,13 +921,19 @@ It is not possible for this list to have 0 elements -- \begin{code} instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where - ppr (TyFamInstDecl { tfid_group = False, tfid_eqns = [lEqn] }) - = let eqn = unLoc lEqn in - ptext (sLit "type instance") <+> (ppr eqn) - ppr (TyFamInstDecl { tfid_eqns = eqns }) - = hang (ptext (sLit "type instance where")) + ppr = pprTyFamInstDecl TopLevel + +pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc +pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_group = False, tfid_eqns = [eqn] }) + = ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> (ppr eqn) +pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqns = eqns }) + = hang (ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ptext (sLit "where")) 2 (vcat (map ppr eqns)) +ppr_instance_keyword :: TopLevelFlag -> SDoc +ppr_instance_keyword TopLevel = ptext (sLit "instance") +ppr_instance_keyword NotTopLevel = empty + instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where ppr (TyFamInstEqn { tfie_tycon = tycon , tfie_pats = pats @@ -935,10 +941,15 @@ instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where = (pp_fam_inst_lhs tycon pats []) <+> equals <+> (ppr rhs) instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where - ppr (DataFamInstDecl { dfid_tycon = tycon - , dfid_pats = pats - , dfid_defn = defn }) - = pp_data_defn ((ptext (sLit "instance") <+>) . (pp_fam_inst_lhs tycon pats)) defn + ppr = pprDataFamInstDecl TopLevel + +pprDataFamInstDecl :: OutputableBndr name => TopLevelFlag -> DataFamInstDecl name -> SDoc +pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon + , dfid_pats = pats + , dfid_defn = defn }) + = pp_data_defn pp_hdr defn + where + pp_hdr ctxt = ppr_instance_keyword top_lvl <+> pp_fam_inst_lhs tycon pats ctxt pprDataFamInstFlavour :: DataFamInstDecl name -> SDoc pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd }) }) @@ -948,14 +959,15 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds , cid_sigs = sigs, cid_tyfam_insts = ats , cid_datafam_insts = adts }) - | null sigs && null ats && isEmptyBag binds -- No "where" part + | null sigs, null ats, null adts, isEmptyBag binds -- No "where" part = top_matter | otherwise -- Laid out = vcat [ top_matter <+> ptext (sLit "where") - , nest 2 $ pprDeclList (map ppr ats ++ - map ppr adts ++ - pprLHsBindsForUser binds sigs) ] + , nest 2 $ pprDeclList $ + map (pprTyFamInstDecl NotTopLevel . unLoc) ats ++ + map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++ + pprLHsBindsForUser binds sigs ] where top_matter = ptext (sLit "instance") <+> ppr inst_ty _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
