[project @ 1998-05-08 12:29:10 by simonm]

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

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index ca2f4e6..14bd691 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -18,18 +18,17 @@ module PprCore (
 
 import CoreSyn
 import CostCentre      ( showCostCentre )
-import Id              ( idType, getIdInfo, isTupleCon,
+import Id              ( idType, idInfo, isTupleCon,
                          DataCon, GenId{-instances-}, Id
                        ) 
 import IdInfo          ( ppIdInfo, ppStrictnessInfo )
 import Literal         ( Literal{-instances-} )
 import Outputable      -- quite a few things
 import PprEnv
-import PprType         ( pprParendGenType, pprTyVarBndr, GenType{-instances-}, GenTyVar{-instance-} )
+import PprType         ( pprParendType, pprTyVarBndr )
 import PrimOp          ( PrimOp{-instances-} )
 import TyVar           ( GenTyVar{-instances-} )
 import Unique          ( Unique{-instances-} )
-import Util            ( panic{-ToDo:rm-} )
 \end{code}
 
 %************************************************************************
@@ -120,7 +119,7 @@ init_ppr_env tvbndr pbdr pocc
 
        (Just tvbndr)           -- tyvar binders
        (Just ppr)              -- tyvar occs
-       (Just pprParendGenType) -- types
+       (Just pprParendType)    -- types
 
        (Just pbdr) (Just pocc) -- value vars
   where
@@ -197,7 +196,7 @@ ppr_expr pe expr@(Lam _ _)
   where
     pp_vars lam pp [] = empty
     pp_vars lam pp vs
-      = hsep [ptext lam, hsep (map pp vs), ptext SLIT("->")]
+      = hsep [ptext lam, vcat (map pp vs), ptext SLIT("->")]
 
 ppr_expr pe expr@(App fun arg)
   = let
@@ -271,15 +270,27 @@ ppr_expr pe (Let bind expr)
                Rec _      -> SLIT("_letrec_ {")
                NonRec _ _ -> SLIT("let {")
 
-ppr_expr pe (SCC cc expr)
+ppr_expr pe (Note (SCC cc) expr)
   = sep [hsep [ptext SLIT("_scc_"), pSCC pe cc],
-          ppr_parend_expr pe expr ]
-
-ppr_expr pe (Coerce c ty expr)
-  = sep [pp_coerce c, pTy pe ty, ppr_expr pe expr]
-  where
-    pp_coerce (CoerceIn  v) = (<>) (ptext SLIT("_coerce_in_ "))  (ppr v)
-    pp_coerce (CoerceOut v) = (<>) (ptext SLIT("_coerce_out_ ")) (ppr v)
+        ppr_parend_expr pe expr ]
+
+#ifdef DEBUG
+ppr_expr pe (Note (Coerce to_ty from_ty) expr)
+ = \ sty ->
+   if debugStyle sty && not (ifaceStyle sty) then
+      sep [hsep [ptext SLIT("_coerce_"), pTy pe to_ty, pTy pe from_ty],
+                 ppr_parend_expr pe expr] sty
+   else
+      sep [hsep [ptext SLIT("_coerce_"), pTy pe to_ty],
+                 ppr_parend_expr pe expr] sty
+#else
+ppr_expr pe (Note (Coerce to_ty from_ty) expr)
+  = sep [hsep [ptext SLIT("_coerce_"), pTy pe to_ty],
+        ppr_parend_expr pe expr]
+#endif
+
+ppr_expr pe (Note InlineCall expr)
+  = ptext SLIT("_inline_") <+> ppr_parend_expr pe expr
 
 only_one_alt (AlgAlts []     (BindDefault _ _)) = True
 only_one_alt (AlgAlts (_:[])  NoDefault)       = True
@@ -337,7 +348,7 @@ pprCoreBinder LetBind binder
   = vcat [sig, pragmas, ppr binder]
   where
     sig     = pprTypedBinder binder
-    pragmas = ppIdInfo False{-no specs, thanks-} (getIdInfo binder)
+    pragmas = ppIdInfo False{-no specs, thanks-} (idInfo binder)
 
 pprCoreBinder LambdaBind binder = pprTypedBinder binder
 pprCoreBinder CaseBind   binder = ppr binder
@@ -348,7 +359,7 @@ pprIfaceBinder CaseBind binder = ppr binder
 pprIfaceBinder other    binder = pprTypedBinder binder
 
 pprTypedBinder binder
-  = ppr binder <+> ptext SLIT("::") <+> pprParendGenType (idType binder)
+  = ppr binder <+> ptext SLIT("::") <+> pprParendType (idType binder)
        -- The space before the :: is important; it helps the lexer
        -- when reading inferfaces.  Otherwise it would lex "a::b" as one thing.
        --