X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FPprTyThing.hs;h=dfa713fdc0b13276cc52d5ee9ba06ed3cf7e602d;hp=c9e0b2afc57ae8513e9c29c6d9fc2868878a55e0;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=b0b28c95913af2d656b99c7431e32351cad4629f

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index c9e0b2a..dfa713f 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -20,7 +20,6 @@ import qualified GHC
 
 import GHC ( TyThing(..) )
 import TyCon
-import Type ( TyThing(..), tidyTopType, pprTypeApp )
 import TcType
 import Var
 import Name
@@ -76,7 +75,7 @@ pprTyThingHdr pefas (AClass cls)       = pprClassHdr   pefas cls
 pprTyConHdr :: PrintExplicitForalls -> TyCon -> SDoc
 pprTyConHdr _ tyCon
   | Just (_fam_tc, tys) <- tyConFamInst_maybe tyCon
-  = ptext keyword <+> ptext (sLit "instance") <+> pprTypeApp tyCon (ppr_bndr tyCon) tys
+  = ptext keyword <+> ptext (sLit "instance") <+> pprTypeApp tyCon tys
   | otherwise
   = ptext keyword <+> opt_family <+> opt_stupid <+> ppr_bndr tyCon <+> hsep (map ppr vars)
   where
@@ -198,13 +197,9 @@ pprDataConDecl _ gadt_style show_label dataCon
     pp_tau = foldr add (ppr res_ty) tys_w_strs
     add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
 
-    pprParendBangTy (strict,ty)
-	| GHC.isMarkedStrict strict = char '!' <> GHC.pprParendType ty
-	| otherwise		    = GHC.pprParendType ty
+    pprParendBangTy (bang,ty) = ppr bang <> GHC.pprParendType ty
 
-    pprBangTy strict ty
-	| GHC.isMarkedStrict strict = char '!' <> ppr ty
-	| otherwise		    = ppr ty
+    pprBangTy bang ty = ppr bang <> ppr ty
 
     maybe_show_label (lbl,(strict,tp))
 	| show_label lbl = Just (ppr lbl <+> dcolon <+> pprBangTy strict tp)
@@ -212,7 +207,7 @@ pprDataConDecl _ gadt_style show_label dataCon
 
     ppr_fields [ty1, ty2]
 	| GHC.dataConIsInfix dataCon && null labels
-	= sep [pprParendBangTy ty1, ppr dataCon, pprParendBangTy ty2]
+	= sep [pprParendBangTy ty1, pprInfixName dataCon, pprParendBangTy ty2]
     ppr_fields fields
 	| null labels
 	= ppr_bndr dataCon <+> sep (map pprParendBangTy fields)