X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgCmmRep.hs;h=0d367ad33ecabb33c0cc9de294e4fedd673289f5;hb=7457c489e32a326224673a07281ae402ee4d25fc;hp=71e206e4f638fca22d1b54292b956aa03c19f0c3;hpb=c0a5a5d2e41341046aaf37c1d2155372e7ed3ee8;p=ghc-hetmet.git

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index 71e206e..0d367ad 100644
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -29,8 +29,7 @@ import ZipCfg
 import MkZipCfg
 
 import Maybes
-import Outputable hiding (empty)
-import qualified Outputable as PP
+import Outputable
 import Prelude hiding (zip, unzip, last)
 
 type CmmGraph  = LGraph Middle Last
@@ -157,12 +156,14 @@ instance Outputable Convention where
 instance DF.DebugNodes Middle Last
 
 instance Outputable CmmGraph where
-    ppr = pprCmmGraphAsRep
+    ppr = pprLgraph
 
-pprCmmGraphAsRep :: CmmGraph -> SDoc
-pprCmmGraphAsRep g = vcat (map ppr_block blocks)
-    where blocks = postorder_dfs g
-          ppr_block (Block id tail) = hang (ppr id <> colon) 4 (ppr tail)
+debugPpr :: Bool
+#ifdef DEBUG 
+debugPpr = True
+#else
+debugPpr = False
+#endif
 
 pprMiddle :: Middle -> SDoc    
 pprMiddle stmt = (case stmt of
@@ -175,7 +176,7 @@ pprMiddle stmt = (case stmt of
              ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
 
     CopyOut conv args ->
-        if null args then PP.empty
+        if null args then empty
         else ptext SLIT("CopyOut") <+> doubleQuotes(ppr conv) <+>
              parens (commafy (map pprHinted args))
 
@@ -194,7 +195,7 @@ pprMiddle stmt = (case stmt of
     -- ToDo ppr volatile
     MidUnsafeCall (CmmCallee fn cconv) results args ->
         hcat [ if null results
-                  then PP.empty
+                  then empty
                   else parens (commafy $ map ppr results) <>
                        ptext SLIT(" = "),
                ptext SLIT("call"), space, 
@@ -209,15 +210,17 @@ pprMiddle stmt = (case stmt of
         pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
         where
           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
-  ) <+> text "//" <+>
-  case stmt of
-    MidNop {} -> text "MidNop"
-    CopyIn {} -> text "CopyIn"
-    CopyOut {} -> text "CopyOut"
-    MidComment {} -> text "MidComment"
-    MidAssign {} -> text "MidAssign"
-    MidStore {} -> text "MidStore"
-    MidUnsafeCall {} -> text "MidUnsafeCall"
+  ) <>
+  if debugPpr then empty
+  else text " //" <+>
+       case stmt of
+         MidNop {}     -> text "MidNop"
+         CopyIn {}     -> text "CopyIn"
+         CopyOut {}    -> text "CopyOut"
+         MidComment {} -> text "MidComment"
+         MidAssign {}  -> text "MidAssign"
+         MidStore {}   -> text "MidStore"
+         MidUnsafeCall {} -> text "MidUnsafeCall"
 
 
 pprHinted :: Outputable a => (a, MachHint) -> SDoc
@@ -236,15 +239,16 @@ pprLast stmt = (case stmt of
                                       , semi ]
     LastSwitch arg ids        -> ppr $ CmmSwitch arg ids
     LastCall tgt params k     -> genCall tgt params k
-  ) <+> text "//" <+>
-  case stmt of
-    LastBranch {} -> text "LastBranch"
-    LastCondBranch {} -> text "LastCondBranch"
-    LastJump {} -> text "LastJump"
-    LastReturn {} -> text "LastReturn"
-    LastSwitch {} -> text "LastSwitch"
-    LastCall {} -> text "LastCall"
-
+  ) <>
+  if debugPpr then empty
+  else text " //" <+>
+       case stmt of
+         LastBranch {} -> text "LastBranch"
+         LastCondBranch {} -> text "LastCondBranch"
+         LastJump {} -> text "LastJump"
+         LastReturn {} -> text "LastReturn"
+         LastSwitch {} -> text "LastSwitch"
+         LastCall {} -> text "LastCall"
 
 genCall :: CmmCallTarget -> CmmActuals -> Maybe BlockId -> SDoc
 genCall (CmmCallee fn cconv) args k =