diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 3691fcabc07fe53a70be9bd9801dd1c93c74d8d3..8ca8582bc236834fda687d29b57898899a42f45c 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -55,6 +55,7 @@ import TysWiredIn ( eqTyConName ) import Fingerprint import Binary import BooleanFormula ( BooleanFormula ) +import HsBinds import Control.Monad import System.IO.Unsafe @@ -1104,27 +1105,22 @@ pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branche pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap, ifPatIsInfix = is_infix, - ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs, + ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs, ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt, ifPatArgs = args, ifPatTy = ty }) - = hang (text "pattern" <+> header) - 4 details + = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt) where - header = ppr name <+> dcolon <+> - (pprIfaceForAllPart univ_tvs req_ctxt $ - pprIfaceForAllPart ex_tvs prov_ctxt $ - pp_tau) + args' = case (is_infix, map snd args) of + (True, [left_ty, right_ty]) -> + InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty) + (_, tys) -> + PrefixPatSyn (map pprParendIfaceType tys) - details = sep [ if is_infix then text "Infix" else empty - , if has_wrap then text "HasWrapper" else empty - ] + ty' = pprParendIfaceType ty - pp_tau = case map pprParendIfaceType (arg_tys ++ [ty]) of - (t:ts) -> fsep (t : map (arrow <+>) ts) - [] -> panic "pp_tau" - - arg_tys = map snd args + pprCtxt [] = Nothing + pprCtxt ctxt = Just $ pprIfaceContext ctxt pprCType :: Maybe CType -> SDoc pprCType Nothing = ptext (sLit "No C type associated")