X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FPprCore.lhs;h=20f0b4d1c1687b499912a118b836fe3c5444c35b;hb=ca5a4a480d10d61e5b7a52eb4d556e8b8c33e69d;hp=4a503e47aae984f6e9ef5515acfb993a44f6aab9;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 4a503e4..20f0b4d 100644
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -17,7 +17,7 @@ module PprCore (
 	pprTypedCoreBinder
 	
 	-- these are here to make the instances go in 0.26:
-#if __GLASGOW_HASKELL__ <= 26
+#if __GLASGOW_HASKELL__ <= 30
 	, GenCoreBinding, GenCoreExpr, GenCoreCaseAlts
 	, GenCoreCaseDefault, GenCoreArg
 #endif
@@ -27,11 +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		( isSymLexeme )
 import Outputable	-- quite a few things
 import PprEnv
 import PprType		( GenType{-instances-}, GenTyVar{-instance-} )
@@ -295,6 +296,13 @@ ppr_expr pe (Let bind expr)
 ppr_expr pe (SCC cc expr)
   = ppSep [ppCat [ppPStr SLIT("_scc_"), pSCC pe cc],
 	   ppr_parend_expr pe expr ]
+
+ppr_expr pe (Coerce c ty expr)
+  = ppSep [ppCat [ppPStr SLIT("_coerce_"), pp_coerce c],
+	   pTy pe ty, ppr_parend_expr pe expr ]
+  where
+    pp_coerce (CoerceIn  v) = ppBeside (ppStr "{-in-}")  (ppr (pStyle pe) v)
+    pp_coerce (CoerceOut v) = ppBeside (ppStr "{-out-}") (ppr (pStyle pe) v)
 \end{code}
 
 \begin{code}
@@ -302,13 +310,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 ]