diff options
Diffstat (limited to 'compiler/GHC/Iface/Syntax.hs')
| -rw-r--r-- | compiler/GHC/Iface/Syntax.hs | 25 |
1 files changed, 16 insertions, 9 deletions
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs index 198b5eb5f4..da54049413 100644 --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -804,7 +804,7 @@ constraintIfaceKind = pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi --- See Note [Pretty-printing TyThings] in GHC.Types.TyThing.Ppr +-- See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, ifCtxt = context, ifResKind = kind, ifRoles = roles, ifCons = condecls, @@ -1023,19 +1023,26 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs, ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt, - ifPatArgs = arg_tys, + ifPatArgs = arg_tys, ifFieldLabels = pat_fldlbls, ifPatTy = pat_ty} ) = sdocWithContext mk_msg where + pat_keywrd = text "pattern" mk_msg sdocCtx - = hang (text "pattern" <+> pprPrefixOcc name) - 2 (dcolon <+> sep [univ_msg - , pprIfaceContextArr req_ctxt - , ppWhen insert_empty_ctxt $ parens empty <+> darrow - , ex_msg - , pprIfaceContextArr prov_ctxt - , pprIfaceType $ foldr (IfaceFunTy VisArg many_ty) pat_ty arg_tys ]) + = vcat [ ppr_pat_ty + -- only print this for record pattern synonyms + , if null pat_fldlbls then Outputable.empty + else pat_keywrd <+> pprPrefixOcc name <+> pat_body] where + ppr_pat_ty = + hang (pat_keywrd <+> pprPrefixOcc name) + 2 (dcolon <+> sep [univ_msg + , pprIfaceContextArr req_ctxt + , ppWhen insert_empty_ctxt $ parens empty <+> darrow + , ex_msg + , pprIfaceContextArr prov_ctxt + , pprIfaceType $ foldr (IfaceFunTy VisArg many_ty) pat_ty arg_tys ]) + pat_body = braces $ sep $ punctuate comma $ map ppr pat_fldlbls univ_msg = pprUserIfaceForAll $ tyVarSpecToBinders univ_bndrs ex_msg = pprUserIfaceForAll $ tyVarSpecToBinders ex_bndrs |