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

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 8e1c73d..2aff67f 100644
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -27,7 +27,7 @@ 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(..) )
@@ -303,9 +303,14 @@ 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