[project @ 1996-04-25 16:31:20 by partain]

[ghc-hetmet.git] / ghc / compiler / coreSyn / PprCore.lhs

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 412c62d..2aff67f 100644 (file)
--- 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 ]