diff options
Diffstat (limited to 'compiler/iface/IfaceSyn.hs')
| -rw-r--r-- | compiler/iface/IfaceSyn.hs | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 463078ce67..307a448ec9 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -869,9 +869,12 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConExTvs = ex_tvs, ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys, - ifConStricts = stricts, ifConFields = labels }) - | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty - | otherwise = ppr_fields tys_w_strs + ifConStricts = stricts, ifConFields = fields }) + | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty + | not (null fields) = pp_prefix_con <+> pp_field_args + | is_infix + , [ty1, ty2] <- pp_args = sep [ty1, pprInfixIfDeclBndr ss name, ty2] + | otherwise = pp_prefix_con <+> sep pp_args where tys_w_strs :: [(IfaceBang, IfaceType)] tys_w_strs = zip stricts arg_tys @@ -882,9 +885,12 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls -- A bit gruesome this, but we can't form the full con_tau, and ppr it, -- because we don't have a Name for the tycon, only an OccName - pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of + pp_tau | null fields + = case pp_args ++ [pp_res_ty] of (t:ts) -> fsep (t : map (arrow <+>) ts) [] -> panic "pp_con_taus" + | otherwise + = sep [pp_field_args, arrow <+> pp_res_ty] ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_' ppr_bang IfStrict = char '!' @@ -895,6 +901,13 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty pprBangTy (bang, ty) = ppr_bang bang <> ppr ty + pp_args :: [SDoc] -- With parens, e.g (Maybe a) or !(Maybe a) + pp_args = map pprParendBangTy tys_w_strs + + pp_field_args :: SDoc -- Braces form: { x :: !Maybe a, y :: Int } + pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $ + map maybe_show_label (zip fields tys_w_strs) + maybe_show_label (sel,bty) | showSub ss sel = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty) | otherwise = Nothing @@ -904,14 +917,6 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls -- DuplicateRecordFields was used for the definition) lbl = maybe sel (mkVarOccFS . flLabel) $ find (\ fl -> flSelector fl == sel) fls - ppr_fields [ty1, ty2] - | is_infix && null labels - = sep [pprParendBangTy ty1, pprInfixIfDeclBndr ss name, pprParendBangTy ty2] - ppr_fields fields - | null labels = pp_prefix_con <+> sep (map pprParendBangTy fields) - | otherwise = pp_prefix_con <+> (braces $ sep $ punctuate comma $ ppr_trim $ - map maybe_show_label (zip labels fields)) - instance Outputable IfaceRule where ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs, ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) |