X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FPprCore.lhs;h=2aff67f223293ed973012b21c8b97160b4da877a;hb=a77abe6a30ea2763cfa1c0ca83cdce9b7200ced2;hp=412c62d4c5ce674ab403bc0fb1a724217de371f5;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 412c62d..2aff67f 100644
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -27,12 +27,12 @@ import Ubiq{-uitous-}
 
 import CoreSyn
 import CostCentre	( showCostCentre )
-import Id		( idType, getIdInfo, getIdStrictness,
+import Id		( idType, getIdInfo, getIdStrictness, isTupleCon,
 			  nullIdEnv, DataCon(..), GenId{-instances-}
 			)
 import IdInfo		( ppIdInfo, StrictnessInfo(..) )
 import Literal		( Literal{-instances-} )
-import Name		( isOpLexeme )
+import Name		( isSymLexeme )
 import Outputable	-- quite a few things
 import PprEnv
 import PprType		( GenType{-instances-}, GenTyVar{-instance-} )
@@ -303,13 +303,18 @@ ppr_alts pe (AlgAlts alts deflt)
   = ppAboves [ ppAboves (map ppr_alt alts), ppr_default pe deflt ]
   where
     ppr_alt (con, params, expr)
-      = ppHang (ppCat [ppr_con con (pCon pe con),
-		       ppInterleave ppSP (map (pMinBndr pe) params),
-		       ppStr "->"])
+      = ppHang (if isTupleCon con then
+		    ppCat [ppParens (ppInterleave ppComma (map (pMinBndr pe) params)),
+			   ppStr "->"]
+		else
+		    ppCat [ppr_con con (pCon pe con),
+			   ppInterleave ppSP (map (pMinBndr pe) params),
+			   ppStr "->"]
+	       )
 	     4 (ppr_expr pe expr)
       where
     	ppr_con con pp_con
-    	  = if isOpLexeme con then ppParens pp_con else pp_con
+    	  = if isSymLexeme con then ppParens pp_con else pp_con
 
 ppr_alts pe (PrimAlts alts deflt)
   = ppAboves [ ppAboves (map ppr_alt alts), ppr_default pe deflt ]