[project @ 1996-06-26 10:26:00 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 8e1c73d..309d62d 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -17,25 +17,25 @@ 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
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import CoreSyn
 import CostCentre      ( showCostCentre )
-import Id              ( idType, getIdInfo, getIdStrictness,
-                         nullIdEnv, DataCon(..), GenId{-instances-}
+import Id              ( idType, getIdInfo, getIdStrictness, isTupleCon,
+                         nullIdEnv, SYN_IE(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-} )
+import PprType         ( pprParendGenType, GenType{-instances-}, GenTyVar{-instance-} )
 import PprStyle                ( PprStyle(..) )
 import Pretty
 import PrimOp          ( PrimOp{-instances-} )
@@ -91,7 +91,7 @@ init_ppr_env sty pbdr1 pbdr2 pocc
        (Just (ppr sty)) -- tyvars
        (Just (ppr sty)) -- usage vars
        (Just pbdr1) (Just pbdr2) (Just pocc) -- value vars
-       (Just (ppr sty)) -- types
+       (Just (pprParendGenType sty)) -- types
        (Just (ppr sty)) -- usages
 
 --------------
@@ -296,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}
@@ -303,9 +310,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