pprIfaceDecl for IfacePatSyn: use pprPatSynSig
authorDr. ERDI Gergo <gergo@erdi.hu>
Wed, 12 Mar 2014 12:38:54 +0000 (20:38 +0800)
committerDr. ERDI Gergo <gergo@erdi.hu>
Thu, 13 Mar 2014 13:20:51 +0000 (21:20 +0800)
compiler/iface/IfaceSyn.lhs

index 3691fca..8ca8582 100644 (file)
@@ -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")