Snapshot of codegen refactoring to share with simonpj
[ghc.git] / compiler / cmm / PprCmmDecl.hs
1 ----------------------------------------------------------------------------
2 --
3 -- Pretty-printing of common Cmm types
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 --
10 -- This is where we walk over Cmm emitting an external representation,
11 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
12 -- is the "External Core" for the Cmm layer.
13 --
14 -- As such, this should be a well-defined syntax: we want it to look nice.
15 -- Thus, we try wherever possible to use syntax defined in [1],
16 -- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
17 -- slightly, in some cases. For one, we use I8 .. I64 for types, rather
18 -- than C--'s bits8 .. bits64.
19 --
20 -- We try to ensure that all information available in the abstract
21 -- syntax is reproduced, or reproducible, in the concrete syntax.
22 -- Data that is not in printed out can be reconstructed according to
23 -- conventions used in the pretty printer. There are at least two such
24 -- cases:
25 -- 1) if a value has wordRep type, the type is not appended in the
26 -- output.
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
29 --
30 -- These conventions produce much more readable Cmm output.
31 --
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
33 --
34
35 module PprCmmDecl
36 ( writeCmms, pprCmms, pprCmmPgm, pprSection, pprStatic
37 )
38 where
39
40 import CLabel
41 import PprCmmExpr
42 import Cmm
43
44 import Outputable
45 import Platform
46 import FastString
47
48 import Data.List
49 import System.IO
50
51 -- Temp Jan08
52 import SMRep
53 #include "../includes/rts/storage/FunTypes.h"
54
55
56 pprCmms :: (Outputable info, PlatformOutputable g)
57 => Platform -> [GenCmmPgm CmmStatics info g] -> SDoc
58 pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms))
59 where
60 separator = space $$ ptext (sLit "-------------------") $$ space
61
62 writeCmms :: (Outputable info, PlatformOutputable g)
63 => Platform -> Handle -> [GenCmmPgm CmmStatics info g] -> IO ()
64 writeCmms platform handle cmms = printForC handle (pprCmms platform cmms)
65
66 -----------------------------------------------------------------------------
67
68 instance (Outputable d, Outputable info, PlatformOutputable i)
69 => PlatformOutputable (GenCmmTop d info i) where
70 pprPlatform platform t = pprTop platform t
71
72 instance Outputable CmmStatics where
73 ppr e = pprStatics e
74
75 instance Outputable CmmStatic where
76 ppr e = pprStatic e
77
78 instance Outputable CmmInfoTable where
79 ppr e = pprInfoTable e
80
81
82 -----------------------------------------------------------------------------
83
84 pprCmmPgm :: (Outputable d, Outputable info, PlatformOutputable g)
85 => Platform -> GenCmmPgm d info g -> SDoc
86 pprCmmPgm platform tops
87 = vcat $ intersperse blankLine $ map (pprTop platform) tops
88
89 -- --------------------------------------------------------------------------
90 -- Top level `procedure' blocks.
91 --
92 pprTop :: (Outputable d, Outputable info, PlatformOutputable i)
93 => Platform -> GenCmmTop d info i -> SDoc
94
95 pprTop platform (CmmProc info lbl graph)
96
97 = vcat [ pprCLabel lbl <> lparen <> rparen
98 , nest 8 $ lbrace <+> ppr info $$ rbrace
99 , nest 4 $ pprPlatform platform graph
100 , rbrace ]
101
102 -- --------------------------------------------------------------------------
103 -- We follow [1], 4.5
104 --
105 -- section "data" { ... }
106 --
107 pprTop _ (CmmData section ds) =
108 (hang (pprSection section <+> lbrace) 4 (ppr ds))
109 $$ rbrace
110
111 -- --------------------------------------------------------------------------
112 -- Info tables.
113
114 pprInfoTable :: CmmInfoTable -> SDoc
115 pprInfoTable CmmNonInfoTable
116 = empty
117 pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
118 , cit_prof = prof_info
119 , cit_srt = _srt })
120 = vcat [ ptext (sLit "label:") <+> ppr lbl
121 , ptext (sLit "rep:") <> ppr rep
122 , case prof_info of
123 NoProfilingInfo -> empty
124 ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
125 , ptext (sLit "desc: ") <> pprWord8String cd ] ]
126
127 instance Outputable C_SRT where
128 ppr (NoC_SRT) = ptext (sLit "_no_srt_")
129 ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma
130 <> text (show bitmap))
131
132 instance Outputable ForeignHint where
133 ppr NoHint = empty
134 ppr SignedHint = quotes(text "signed")
135 -- ppr AddrHint = quotes(text "address")
136 -- Temp Jan08
137 ppr AddrHint = (text "PtrHint")
138
139 -- --------------------------------------------------------------------------
140 -- Static data.
141 -- Strings are printed as C strings, and we print them as I8[],
142 -- following C--
143 --
144 pprStatics :: CmmStatics -> SDoc
145 pprStatics (Statics lbl ds) = vcat ((pprCLabel lbl <> colon) : map ppr ds)
146
147 pprStatic :: CmmStatic -> SDoc
148 pprStatic s = case s of
149 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
150 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
151 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
152
153 -- --------------------------------------------------------------------------
154 -- data sections
155 --
156 pprSection :: Section -> SDoc
157 pprSection s = case s of
158 Text -> section <+> doubleQuotes (ptext (sLit "text"))
159 Data -> section <+> doubleQuotes (ptext (sLit "data"))
160 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
161 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
162 RelocatableReadOnlyData
163 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
164 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
165 OtherSection s' -> section <+> doubleQuotes (text s')
166 where
167 section = ptext (sLit "section")