[commit: ghc] wip/T8776: pprIfaceDecl for IfacePatSyn: use pprPatSynSig (880a37b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T8776
Link       : http://ghc.haskell.org/trac/ghc/changeset/880a37bd08b431699d8585c522e7f5b9ac33bc21/ghc

>---------------------------------------------------------------

commit 880a37bd08b431699d8585c522e7f5b9ac33bc21
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Wed Mar 12 20:38:54 2014 +0800

    pprIfaceDecl for IfacePatSyn: use pprPatSynSig


>---------------------------------------------------------------

880a37bd08b431699d8585c522e7f5b9ac33bc21
 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 3691fca..8ca8582 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")