From: simonpj@microsoft.com <unknown>
Date: Wed, 21 Mar 2007 09:36:11 +0000 (+0000)
Subject: Improve pretty-printing for IfaceConDecl
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a87585834a44554097466c7b7b1564494957846b;hp=2aac6672c88621c7c09bda8452f06f8b2dc50647;p=ghc-hetmet.git

Improve pretty-printing for IfaceConDecl
---

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index fac6c34..267a8cc 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -31,13 +31,11 @@ import IfaceType
 import NewDemand
 import Class
 import UniqFM
-import Unique
 import NameSet 
 import Name
 import CostCentre
 import Literal
 import ForeignCall
-import SrcLoc
 import BasicTypes
 import Outputable
 import FastString
@@ -431,6 +429,7 @@ pp_condecls tc IfOpenDataTyCon  = empty
 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
 							     (map (pprIfaceConDecl tc) cs))
 
+pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc
 	(IfCon { ifConOcc = name, ifConInfix = is_infix, 
 		 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, 
@@ -444,15 +443,18 @@ pprIfaceConDecl tc
 	      else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
   where
     main_payload = ppr name <+> dcolon <+> 
-		   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) (ppr con_tau)
+		   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty) 
 	      | (tv,ty) <- eq_spec] 
-    con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
-    tc_app  = IfaceTyConApp (IfaceTc tc_name)
-			    [IfaceTyVar tv | (tv,_) <- univ_tvs]
-    tc_name = mkInternalName (mkBuiltinUnique 1) tc noSrcLoc
-	-- Really Gruesome, but just for debug print
+
+	-- 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
+		(t:ts) -> fsep (t : map (arrow <+>) ts)
+		[]     -> panic "pp_con_taus"
+
+    pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 
 instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,