X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsTypes.lhs;h=806faf29dc0e9ffdc986fa6d9d74c20ad160c84d;hb=fc7a2876f23510ab795ab2098bbac278d29d6356;hp=9b3930531e199835a286f372d3a66c97a7f6265a;hpb=f278f0676579f67075033a4f9857715909c4b71e;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 9b39305..806faf2 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -102,17 +102,6 @@ ppr_qq (HsQuasiQuote quoter _ quote) =
 type LBangType name = Located (BangType name)
 type BangType name  = HsType name	-- Bangs are in the HsType data type
 
-data HsBang = HsNoBang	-- Only used as a return value for getBangStrictness,
-			-- never appears on a HsBangTy
-	    | HsStrict	-- ! 
-	    | HsUnbox	-- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
-  deriving (Data, Typeable)
-
-instance Outputable HsBang where
-    ppr (HsNoBang) = empty
-    ppr (HsStrict) = char '!'
-    ppr (HsUnbox)  = ptext (sLit "!!")
-
 getBangType :: LHsType a -> LHsType a
 getBangType (L _ (HsBangTy _ ty)) = ty
 getBangType ty                    = ty
@@ -364,8 +353,16 @@ pprHsForAll exp tvs cxt
     forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
 
 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
-pprHsContext []	 = empty
-pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
+pprHsContext []	        = empty
+pprHsContext [L _ pred] 
+   | noParenHsPred pred = ppr pred <+> ptext (sLit "=>")
+pprHsContext cxt        = ppr_hs_context cxt <+> ptext (sLit "=>")
+
+noParenHsPred :: HsPred name -> Bool
+-- c.f. TypeRep.noParenPred
+noParenHsPred (HsClassP {}) = True
+noParenHsPred (HsEqualP {}) = True
+noParenHsPred (HsIParam {}) = False
 
 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
 ppr_hs_context []  = empty