+{-# 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/Commentary/CodingStyle#Warnings
+-- for details
+
----------------------------------------------------------------------------
--
-- Pretty-printing of Cmm as (a superset of) C--
--
module PprCmm (
- writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
+ writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic
) where
#include "HsVersions.h"
import System.IO
import Data.Maybe
-pprCmms :: (Outputable info) => [GenCmm CmmStatic info CmmStmt] -> SDoc
+pprCmms :: (Outputable info) => [GenCmm CmmStatic info (ListGraph CmmStmt)] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
where
separator = space $$ ptext SLIT("-------------------") $$ space
-----------------------------------------------------------------------------
-instance (Outputable info) => Outputable (GenCmm CmmStatic info CmmStmt) where
+instance (Outputable info) => Outputable (GenCmm CmmStatic info (ListGraph 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 i => Outputable (ListGraph i) where
+ ppr (ListGraph blocks) = vcat (map ppr blocks)
+
+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
instance Outputable CmmInfo where
ppr e = pprInfo e
+
+
-----------------------------------------------------------------------------
-pprCmm :: (Outputable info) => GenCmm CmmStatic info CmmStmt -> SDoc
+pprCmm :: (Outputable info) => GenCmm CmmStatic info (ListGraph CmmStmt) -> SDoc
pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
-pprTop :: (Outputable info) => GenCmmTop CmmStatic info CmmStmt -> SDoc
-pprTop (CmmProc info lbl params blocks )
+pprTop :: (Outputable d, Outputable info, Outputable g)
+ => GenCmmTop d info g -> SDoc
+
+pprTop (CmmProc info lbl params graph)
= vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
, nest 8 $ lbrace <+> ppr info $$ rbrace
- , nest 4 $ vcat (map ppr blocks)
+ , nest 4 $ ppr graph
, rbrace ]
-- --------------------------------------------------------------------------
-- 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
-- --------------------------------------------------------------------------
-- --------------------------------------------------------------------------
-- 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))