projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add graph coloring register allocator.
[ghc-hetmet.git]
/
compiler
/
cmm
/
PprCmm.hs
diff --git
a/compiler/cmm/PprCmm.hs
b/compiler/cmm/PprCmm.hs
index
72fde55
..
1f5be5c
100644
(file)
--- a/
compiler/cmm/PprCmm.hs
+++ b/
compiler/cmm/PprCmm.hs
@@
-33,7
+33,7
@@
--
module PprCmm (
--
module PprCmm (
- writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
+ writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic
) where
#include "HsVersions.h"
) 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 (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
ppr t = pprTop t
-instance Outputable CmmBasicBlock where
+instance (Outputable instr) => Outputable (GenBasicBlock instr) where
ppr b = pprBBlock b
ppr b = pprBBlock b
+instance Outputable BlockId where
+ ppr id = pprBlockId id
+
instance Outputable CmmStmt where
ppr s = pprStmt s
instance Outputable CmmStmt where
ppr s = pprStmt s
@@
-92,6
+96,8
@@
instance Outputable CmmStatic where
instance Outputable CmmInfo where
ppr e = pprInfo e
instance Outputable CmmInfo where
ppr e = pprInfo e
+
+
-----------------------------------------------------------------------------
pprCmm :: (Outputable info) => GenCmm CmmStatic info CmmStmt -> SDoc
-----------------------------------------------------------------------------
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.
--
-- --------------------------------------------------------------------------
-- 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
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) =
-- 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
-- --------------------------------------------------------------------------
$$ rbrace
-- --------------------------------------------------------------------------
@@
-186,7
+194,7
@@
pprUpdateFrame (UpdateFrame expr args) =
-- --------------------------------------------------------------------------
-- Basic blocks look like assembly blocks.
-- lbl: stmt ; stmt ; ..
-- --------------------------------------------------------------------------
-- 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))
pprBBlock (BasicBlock ident stmts) =
hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))