Fix Trac #3966: warn about useless UNPACK pragmas

[ghc-hetmet.git] / compiler / main / PprTyThing.hs

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index c9e0b2a..dfa713f 100644 (file)
--- 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)