[project @ 2000-01-25 19:18:42 by sewardj]

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

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index c57eb66..92db05f 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -18,13 +18,14 @@ module PprCore (
 
 import CoreSyn
 import CostCentre      ( pprCostCentreCore )
-import Id              ( idType, idInfo, getInlinePragma, getIdDemandInfo, Id )
+import Id              ( idType, idInfo, getInlinePragma, getIdDemandInfo, getIdOccInfo, Id )
 import Var             ( isTyVar )
 import IdInfo          ( IdInfo,
                          arityInfo, ppArityInfo, ppFlavourInfo, flavourInfo,
                          demandInfo, updateInfo, ppUpdateInfo, specInfo, 
                          strictnessInfo, ppStrictnessInfo, cafInfo, ppCafInfo,
-                         cprInfo, ppCprInfo
+                         cprInfo, ppCprInfo, lbvarInfo,
+                         workerInfo, ppWorkerInfo
                        )
 import Const           ( Con(..), DataCon )
 import DataCon         ( isTupleCon, isUnboxedTupleCon )
@@ -259,7 +260,7 @@ ppr_expr pe (Note (Coerce to_ty from_ty) expr)
                  ppr_parend_expr pe expr]
 #else
 ppr_expr pe (Note (Coerce to_ty from_ty) expr)
-  = sep [sep [ptext SLIT("__coerce"), nest 4 pTy pe to_ty],
+  = sep [sep [ptext SLIT("__coerce"), nest 4 (pTy pe to_ty)],
         ppr_parend_expr pe expr]
 #endif
 
@@ -320,7 +321,7 @@ pprIfaceBinder CaseBind binder = pprUntypedBinder binder
 pprIfaceBinder other    binder = pprTypedBinder binder
 
 pprUntypedBinder binder
-  | isTyVar binder = pprTyVarBndr binder
+  | isTyVar binder = ptext SLIT("@") <+> pprTyVarBndr binder
   | otherwise      = pprIdBndr binder
 
 pprTypedBinder binder
@@ -332,8 +333,9 @@ pprTypedBinder binder
        -- It's important that the type is parenthesised too, at least when
        -- printing interfaces, because we get \ x::(a->b) y::(c->d) -> ...
 
--- When printing any Id binder in debug mode, we print its inline pragma
-pprIdBndr id = ppr id <+> ifPprDebug (ppr (getInlinePragma id) <+> ppr (getIdDemandInfo id)) 
+-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
+pprIdBndr id = ppr id <+> ifPprDebug (ppr (getInlinePragma id) <+> ppr (getIdOccInfo id) <+> 
+                                     ppr (getIdDemandInfo id)) <+> ppr (lbvarInfo (idInfo id))
 \end{code}
 
 
@@ -344,10 +346,12 @@ ppIdInfo info
            ppFlavourInfo (flavourInfo info),
            ppArityInfo a,
            ppUpdateInfo u,
+           ppWorkerInfo (workerInfo info),
            ppStrictnessInfo s,
            ppr d,
            ppCafInfo c,
             ppCprInfo m,
+           ppr (lbvarInfo info),
            pprIfaceCoreRules p
        -- Inline pragma printed out with all binders; see PprCore.pprIdBndr
        ]
@@ -370,13 +374,16 @@ pprIfaceCoreRules :: CoreRules -> SDoc
 pprIfaceCoreRules (Rules rules _) = vcat (map (pprCoreRule Nothing) rules)
 
 pprCoreRule :: Maybe Id -> CoreRule -> SDoc
+pprCoreRule maybe_fn (BuiltinRule _)
+  = ifPprDebug (ptext SLIT("A built in rule"))
+
 pprCoreRule maybe_fn (Rule name tpl_vars tpl_args rhs)
   = doubleQuotes (ptext name) <+> 
     sep [
          ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)),
          nest 4 (pp_fn <+> sep (map pprIfaceArg tpl_args)),
          nest 4 (ptext SLIT("=") <+> pprIfaceUnfolding rhs)
-    ]
+    ] <+> semi
   where
     pp_fn = case maybe_fn of
                Just id -> ppr id