[project @ 2005-04-12 09:17:47 by simonmar]

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

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 1c20f51..22ee21b 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -21,9 +21,6 @@ import CostCentre     ( pprCostCentreCore )
 import Var             ( Var )
 import Id              ( Id, idType, isDataConWorkId_maybe, idLBVarInfo, idArity,
                          idInfo, idInlinePragma, idOccInfo,
-#ifdef OLD_STRICTNESS
-                         idDemandInfo, 
-#endif
                          globalIdDetails, isGlobalId, isExportedId, 
                          isSpecPragmaId, idNewDemandInfo
                        )
@@ -33,11 +30,13 @@ import IdInfo               ( IdInfo, megaSeqIdInfo,
                          specInfo, pprNewStrictness,
                          workerInfo, ppWorkerInfo,
                          newStrictnessInfo, cafInfo, ppCafInfo,
+                       )
+
 #ifdef OLD_STRICTNESS
-                         cprInfo, ppCprInfo, 
-                         strictnessInfo, ppStrictnessInfo, 
+import Id              ( idDemandInfo )
+import IdInfo          ( cprInfo, ppCprInfo, strictnessInfo, ppStrictnessInfo ) 
 #endif
-                       )
+
 import DataCon         ( dataConTyCon )
 import TyCon           ( tupleTyConBoxity, isTupleTyCon )
 import Type            ( pprParendType, pprType, pprParendKind )
@@ -155,7 +154,7 @@ ppr_expr add_par expr@(App fun arg)
 
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
   = add_par $
-    sep [sep [ptext SLIT("case") <+> parens (ppr ty) <+> pprCoreExpr expr,
+    sep [sep [ptext SLIT("case") <+> pprParendType ty <+> pprCoreExpr expr,
              hsep [ptext SLIT("of"),
                    ppr_bndr var, 
                    char '{',
@@ -169,7 +168,7 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
 
 ppr_expr add_par (Case expr var ty alts)
   = add_par $
-    sep [sep [ptext SLIT("case") <+> parens (ppr ty) <+> pprCoreExpr expr,
+    sep [sep [ptext SLIT("case") <+> pprParendType ty <+> pprCoreExpr expr,
              ptext SLIT("of") <+> ppr_bndr var <+> char '{'],
         nest 2 (sep (punctuate semi (map pprCoreAlt alts))),
         char '}'
@@ -322,7 +321,8 @@ pprIdDetails id | isGlobalId id     = ppr (globalIdDetails id)
 
 ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo b info
-  = hsep [  ppArityInfo a,
+  = brackets $
+    vcat [  ppArityInfo a,
            ppWorkerInfo (workerInfo info),
            ppCafInfo (cafInfo info),
 #ifdef OLD_STRICTNESS
@@ -330,7 +330,8 @@ ppIdInfo b info
             ppCprInfo m,
 #endif
            pprNewStrictness (newStrictnessInfo info),
-           vcat (map (pprCoreRule (ppr b)) (rulesRules p))
+           if null rules then empty
+           else ptext SLIT("RULES:") <+> vcat (map (pprCoreRule (ppr b)) rules)
        -- Inline pragma, occ, demand, lbvar info
        -- printed out with all binders (when debug is on); 
        -- see PprCore.pprIdBndr
@@ -341,7 +342,7 @@ ppIdInfo b info
     s = strictnessInfo info
     m = cprInfo info
 #endif
-    p = specInfo info
+    rules = rulesRules (specInfo info)
 \end{code}