More CPP removal: pprDynamicLinkerAsmLabel in CLabel
[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, pprCmmGroup, 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 :: (PlatformOutputable info, PlatformOutputable g)
57 => Platform -> [GenCmmGroup 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 :: (PlatformOutputable info, PlatformOutputable g)
63 => Platform -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
64 writeCmms platform handle cmms = printForC handle (pprCmms platform cmms)
65
66 -----------------------------------------------------------------------------
67
68 instance (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
69 => PlatformOutputable (GenCmmDecl d info i) where
70 pprPlatform platform t = pprTop platform t
71
72 instance PlatformOutputable CmmStatics where
73 pprPlatform = pprStatics
74
75 instance PlatformOutputable CmmStatic where
76 pprPlatform = pprStatic
77
78 instance PlatformOutputable CmmInfoTable where
79 pprPlatform = pprInfoTable
80
81
82 -----------------------------------------------------------------------------
83
84 pprCmmGroup :: (PlatformOutputable d,
85 PlatformOutputable info,
86 PlatformOutputable g)
87 => Platform -> GenCmmGroup d info g -> SDoc
88 pprCmmGroup platform tops
89 = vcat $ intersperse blankLine $ map (pprTop platform) tops
90
91 -- --------------------------------------------------------------------------
92 -- Top level `procedure' blocks.
93 --
94 pprTop :: (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
95 => Platform -> GenCmmDecl d info i -> SDoc
96
97 pprTop platform (CmmProc info lbl graph)
98
99 = vcat [ pprCLabel platform lbl <> lparen <> rparen
100 , nest 8 $ lbrace <+> pprPlatform platform info $$ rbrace
101 , nest 4 $ pprPlatform platform graph
102 , rbrace ]
103
104 -- --------------------------------------------------------------------------
105 -- We follow [1], 4.5
106 --
107 -- section "data" { ... }
108 --
109 pprTop platform (CmmData section ds) =
110 (hang (pprSection section <+> lbrace) 4 (pprPlatform platform ds))
111 $$ rbrace
112
113 -- --------------------------------------------------------------------------
114 -- Info tables.
115
116 pprInfoTable :: Platform -> CmmInfoTable -> SDoc
117 pprInfoTable _ CmmNonInfoTable
118 = empty
119 pprInfoTable platform
120 (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
121 , cit_prof = prof_info
122 , cit_srt = _srt })
123 = vcat [ ptext (sLit "label:") <+> pprPlatform platform lbl
124 , ptext (sLit "rep:") <> ppr rep
125 , case prof_info of
126 NoProfilingInfo -> empty
127 ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
128 , ptext (sLit "desc: ") <> pprWord8String cd ] ]
129
130 instance PlatformOutputable C_SRT where
131 pprPlatform _ (NoC_SRT) = ptext (sLit "_no_srt_")
132 pprPlatform platform (C_SRT label off bitmap)
133 = parens (pprPlatform platform label <> comma <> ppr off
134 <> comma <> text (show bitmap))
135
136 instance Outputable ForeignHint where
137 ppr NoHint = empty
138 ppr SignedHint = quotes(text "signed")
139 -- ppr AddrHint = quotes(text "address")
140 -- Temp Jan08
141 ppr AddrHint = (text "PtrHint")
142 instance PlatformOutputable ForeignHint where
143 pprPlatform _ = ppr
144
145 -- --------------------------------------------------------------------------
146 -- Static data.
147 -- Strings are printed as C strings, and we print them as I8[],
148 -- following C--
149 --
150 pprStatics :: Platform -> CmmStatics -> SDoc
151 pprStatics platform (Statics lbl ds) = vcat ((pprCLabel platform lbl <> colon) : map (pprPlatform platform) ds)
152
153 pprStatic :: Platform -> CmmStatic -> SDoc
154 pprStatic platform s = case s of
155 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit platform lit <> semi
156 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
157 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
158
159 -- --------------------------------------------------------------------------
160 -- data sections
161 --
162 pprSection :: Section -> SDoc
163 pprSection s = case s of
164 Text -> section <+> doubleQuotes (ptext (sLit "text"))
165 Data -> section <+> doubleQuotes (ptext (sLit "data"))
166 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
167 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
168 RelocatableReadOnlyData
169 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
170 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
171 OtherSection s' -> section <+> doubleQuotes (text s')
172 where
173 section = ptext (sLit "section")