[project @ 2004-02-12 02:04:59 by mthomas]

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

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 7e67271..29a822a 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -9,9 +9,9 @@
 
 \begin{code}
 module PprCore (
-       pprCoreExpr, pprParendExpr, pprIdBndr,
+       pprCoreExpr, pprParendExpr,
        pprCoreBinding, pprCoreBindings, pprCoreAlt,
-       pprIdRules, pprCoreRule
+       pprIdRules
     ) where
 
 #include "HsVersions.h"
@@ -27,12 +27,12 @@ import Id           ( Id, idType, isDataConWorkId_maybe, idLBVarInfo, idArity,
                          globalIdDetails, isGlobalId, isExportedId, 
                          isSpecPragmaId, idNewDemandInfo
                        )
-import Var             ( isTyVar )
+import Var             ( TyVar, isTyVar, tyVarKind )
 import IdInfo          ( IdInfo, megaSeqIdInfo, 
                          arityInfo, ppArityInfo, 
                          specInfo, pprNewStrictness,
                          workerInfo, ppWorkerInfo,
-                         newStrictnessInfo,
+                         newStrictnessInfo, cafInfo, ppCafInfo,
 #ifdef OLD_STRICTNESS
                          cprInfo, ppCprInfo, 
                          strictnessInfo, ppStrictnessInfo, 
@@ -40,7 +40,7 @@ import IdInfo         ( IdInfo, megaSeqIdInfo,
                        )
 import DataCon         ( dataConTyCon )
 import TyCon           ( tupleTyConBoxity, isTupleTyCon )
-import PprType         ( pprParendType, pprType, pprTyVarBndr )
+import Type            ( pprParendType, pprType, pprParendKind )
 import BasicTypes      ( tupleParens )
 import Util             ( lengthIs )
 import Outputable
@@ -258,8 +258,6 @@ ppr_case_pat con args
 
 pprArg (Type ty) = ptext SLIT("@") <+> pprParendType ty
 pprArg expr      = pprParendExpr expr
-
-arrow = ptext SLIT("->")
 \end{code}
 
 Other printing bits-and-bobs used with the general @pprCoreBinding@
@@ -296,6 +294,17 @@ pprTypedBinder binder
        -- printing interfaces, because we get \ x::(a->b) y::(c->d) -> ...
        --      [Jun 2002: interfaces are now binary, so this doesn't matter]
 
+pprTyVarBndr :: TyVar -> SDoc
+pprTyVarBndr tyvar
+  = getPprStyle $ \ sty ->
+    if debugStyle sty then
+        hsep [ppr tyvar, dcolon, pprParendKind kind]
+               -- See comments with ppDcolon in PprCore.lhs
+    else
+        ppr tyvar
+  where
+    kind = tyVarKind tyvar
+
 -- pprIdBndr does *not* print the type
 -- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
 pprIdBndr id = ppr id <+> 
@@ -321,6 +330,7 @@ ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo b info
   = hsep [  ppArityInfo a,
            ppWorkerInfo (workerInfo info),
+           ppCafInfo (cafInfo info),
 #ifdef OLD_STRICTNESS
            ppStrictnessInfo s,
             ppCprInfo m,
@@ -350,8 +360,7 @@ pprIdRule (id,rule) = pprCoreRule (ppr id) rule
 
 pprCoreRule :: SDoc -> CoreRule -> SDoc
 pprCoreRule pp_fn (BuiltinRule name _)
-  = ifPprDebug (ptext SLIT("Built in rule for") <+> pp_fn <> colon
-                <+> doubleQuotes (ftext name))
+  = ptext SLIT("Built in rule for") <+> pp_fn <> colon <+> doubleQuotes (ftext name)
 
 pprCoreRule pp_fn (Rule name act tpl_vars tpl_args rhs)
   = doubleQuotes (ftext name) <+> ppr act <+>