X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=7a1ffbbf299346fa6ec1f9776ffa9d90dca6d360;hp=72fde55a493ebaac0e956146181df852bd00efa3;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=bb66ce578f2ef5cbeb35de9719f0839a32fbeb35

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 72fde55..7a1ffbb 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 ----------------------------------------------------------------------------
 --
 -- Pretty-printing of Cmm as (a superset of) C--
@@ -33,7 +40,7 @@
 --
 
 module PprCmm ( 	
-	writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
+	writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic
   ) where
 
 #include "HsVersions.h"
@@ -65,12 +72,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 +103,8 @@ instance Outputable CmmStatic where
 instance Outputable CmmInfo where
     ppr e = pprInfo e
 
+
+
 -----------------------------------------------------------------------------
 
 pprCmm :: (Outputable info) => GenCmm CmmStatic info CmmStmt -> SDoc
@@ -100,7 +113,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 +129,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 +201,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))