From 880a37bd08b431699d8585c522e7f5b9ac33bc21 Mon Sep 17 00:00:00 2001
From: "Dr. ERDI Gergo" <gergo@erdi.hu>
Date: Wed, 12 Mar 2014 20:38:54 +0800
Subject: [PATCH] pprIfaceDecl for IfacePatSyn: use pprPatSynSig
---
compiler/iface/IfaceSyn.lhs | 26 +++++++++++---------------
1 file changed, 11 insertions(+), 15 deletions(-)
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 3691fcabc07f..8ca8582bc236 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")
--
GitLab