X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=1f5be5c9d1d5af293a0a3cf62f30f2b5e5c85dc3;hp=72fde55a493ebaac0e956146181df852bd00efa3;hb=0f7d268d00795a58a06ae3c92ebbd14571295b84;hpb=27802c599d26c3358cb9870b6861cd32209bbe58

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 72fde55..1f5be5c 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -33,7 +33,7 @@
 --
 
 module PprCmm ( 	
-	writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
+	writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic
   ) where
 
 #include "HsVersions.h"
@@ -65,12 +65,16 @@ writeCmms handle cmms = printForC handle (pprCmms cmms)
 instance (Outputable info) => Outputable (GenCmm CmmStatic info CmmStmt) where
     ppr c = pprCmm c
 
-instance (Outputable info) => Outputable (GenCmmTop CmmStatic info CmmStmt) where
+instance (Outputable d, Outputable info, Outputable i)
+	=> Outputable (GenCmmTop d info i) where
     ppr t = pprTop t
 
-instance Outputable CmmBasicBlock where
+instance (Outputable instr) => Outputable (GenBasicBlock instr) where
     ppr b = pprBBlock b
 
+instance Outputable BlockId where
+    ppr id = pprBlockId id
+
 instance Outputable CmmStmt where
     ppr s = pprStmt s
 
@@ -92,6 +96,8 @@ instance Outputable CmmStatic where
 instance Outputable CmmInfo where
     ppr e = pprInfo e
 
+
+
 -----------------------------------------------------------------------------
 
 pprCmm :: (Outputable info) => GenCmm CmmStatic info CmmStmt -> SDoc
@@ -100,7 +106,9 @@ pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 --
-pprTop :: (Outputable info) => GenCmmTop CmmStatic info CmmStmt -> SDoc
+pprTop 	:: (Outputable d, Outputable info, Outputable i)
+	=> GenCmmTop d info i -> SDoc
+
 pprTop (CmmProc info lbl params blocks )
 
   = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
@@ -114,7 +122,7 @@ pprTop (CmmProc info lbl params blocks )
 --      section "data" { ... }
 --
 pprTop (CmmData section ds) = 
-    (hang (pprSection section <+> lbrace) 4 (vcat (map pprStatic ds)))
+    (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
     $$ rbrace
 
 -- --------------------------------------------------------------------------
@@ -186,7 +194,7 @@ pprUpdateFrame (UpdateFrame expr args) =
 -- --------------------------------------------------------------------------
 -- Basic blocks look like assembly blocks.
 --      lbl: stmt ; stmt ; .. 
-pprBBlock :: CmmBasicBlock -> SDoc
+pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
 pprBBlock (BasicBlock ident stmts) =
     hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))