Use -fwarn-tabs when validating
[ghc.git] / compiler / cmm / PprCmmExpr.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 {-# OPTIONS -fno-warn-tabs #-}
36 -- The above warning supression flag is a temporary kludge.
37 -- While working on this module you are encouraged to remove it and
38 -- detab the module (please do the detabbing in a separate patch). See
39 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
40 -- for details
41
42 module PprCmmExpr
43 ( pprExpr, pprLit
44 , pprExpr9 {-only to import in OldPprCmm. When it dies, remove the export -}
45 )
46 where
47
48 import CmmExpr
49 import CLabel
50
51 import Outputable
52 import Platform
53 import FastString
54
55 import Data.Maybe
56 import Numeric ( fromRat )
57
58 -----------------------------------------------------------------------------
59
60 instance PlatformOutputable CmmExpr where
61 pprPlatform = pprExpr
62
63 instance Outputable CmmReg where
64 ppr e = pprReg e
65
66 instance PlatformOutputable CmmLit where
67 pprPlatform = pprLit
68
69 instance Outputable LocalReg where
70 ppr e = pprLocalReg e
71 instance PlatformOutputable LocalReg where
72 pprPlatform _ = ppr
73
74 instance Outputable Area where
75 ppr e = pprArea e
76
77 instance Outputable GlobalReg where
78 ppr e = pprGlobalReg e
79
80 -- --------------------------------------------------------------------------
81 -- Expressions
82 --
83
84 pprExpr :: Platform -> CmmExpr -> SDoc
85 pprExpr platform e
86 = case e of
87 CmmRegOff reg i ->
88 pprExpr platform (CmmMachOp (MO_Add rep)
89 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
90 where rep = typeWidth (cmmRegType reg)
91 CmmLit lit -> pprLit platform lit
92 _other -> pprExpr1 platform e
93
94 -- Here's the precedence table from CmmParse.y:
95 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
96 -- %left '|'
97 -- %left '^'
98 -- %left '&'
99 -- %left '>>' '<<'
100 -- %left '-' '+'
101 -- %left '/' '*' '%'
102 -- %right '~'
103
104 -- We just cope with the common operators for now, the rest will get
105 -- a default conservative behaviour.
106
107 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
108 pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
109 pprExpr1 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
110 = pprExpr7 platform x <+> doc <+> pprExpr7 platform y
111 pprExpr1 platform e = pprExpr7 platform e
112
113 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
114
115 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
116 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
117 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
118 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
119 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
120 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
121 infixMachOp1 (MO_U_Gt _) = Just (char '>')
122 infixMachOp1 (MO_U_Lt _) = Just (char '<')
123 infixMachOp1 _ = Nothing
124
125 -- %left '-' '+'
126 pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
127 = pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
128 pprExpr7 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
129 = pprExpr7 platform x <+> doc <+> pprExpr8 platform y
130 pprExpr7 platform e = pprExpr8 platform e
131
132 infixMachOp7 (MO_Add _) = Just (char '+')
133 infixMachOp7 (MO_Sub _) = Just (char '-')
134 infixMachOp7 _ = Nothing
135
136 -- %left '/' '*' '%'
137 pprExpr8 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
138 = pprExpr8 platform x <+> doc <+> pprExpr9 platform y
139 pprExpr8 platform e = pprExpr9 platform e
140
141 infixMachOp8 (MO_U_Quot _) = Just (char '/')
142 infixMachOp8 (MO_Mul _) = Just (char '*')
143 infixMachOp8 (MO_U_Rem _) = Just (char '%')
144 infixMachOp8 _ = Nothing
145
146 pprExpr9 :: Platform -> CmmExpr -> SDoc
147 pprExpr9 platform e =
148 case e of
149 CmmLit lit -> pprLit1 platform lit
150 CmmLoad expr rep -> ppr rep <> brackets (pprPlatform platform expr)
151 CmmReg reg -> ppr reg
152 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
153 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
154 CmmMachOp mop args -> genMachOp platform mop args
155
156 genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
157 genMachOp platform mop args
158 | Just doc <- infixMachOp mop = case args of
159 -- dyadic
160 [x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
161
162 -- unary
163 [x] -> doc <> pprExpr9 platform x
164
165 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
166 (pprMachOp mop <+>
167 parens (hcat $ punctuate comma (map (pprExpr platform) args)))
168 empty
169
170 | isJust (infixMachOp1 mop)
171 || isJust (infixMachOp7 mop)
172 || isJust (infixMachOp8 mop) = parens (pprExpr platform (CmmMachOp mop args))
173
174 | otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
175 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
176 (show mop))
177 -- replace spaces in (show mop) with underscores,
178
179 --
180 -- Unsigned ops on the word size of the machine get nice symbols.
181 -- All else get dumped in their ugly format.
182 --
183 infixMachOp :: MachOp -> Maybe SDoc
184 infixMachOp mop
185 = case mop of
186 MO_And _ -> Just $ char '&'
187 MO_Or _ -> Just $ char '|'
188 MO_Xor _ -> Just $ char '^'
189 MO_Not _ -> Just $ char '~'
190 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
191 _ -> Nothing
192
193 -- --------------------------------------------------------------------------
194 -- Literals.
195 -- To minimise line noise we adopt the convention that if the literal
196 -- has the natural machine word size, we do not append the type
197 --
198 pprLit :: Platform -> CmmLit -> SDoc
199 pprLit platform lit = case lit of
200 CmmInt i rep ->
201 hcat [ (if i < 0 then parens else id)(integer i)
202 , ppUnless (rep == wordWidth) $
203 space <> dcolon <+> ppr rep ]
204
205 CmmFloat f rep -> hsep [ double (fromRat f), dcolon, ppr rep ]
206 CmmLabel clbl -> pprCLabel platform clbl
207 CmmLabelOff clbl i -> pprCLabel platform clbl <> ppr_offset i
208 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel platform clbl1 <> char '-'
209 <> pprCLabel platform clbl2 <> ppr_offset i
210 CmmBlock id -> ppr id
211 CmmHighStackMark -> text "<highSp>"
212
213 pprLit1 :: Platform -> CmmLit -> SDoc
214 pprLit1 platform lit@(CmmLabelOff {}) = parens (pprLit platform lit)
215 pprLit1 platform lit = pprLit platform lit
216
217 ppr_offset :: Int -> SDoc
218 ppr_offset i
219 | i==0 = empty
220 | i>=0 = char '+' <> int i
221 | otherwise = char '-' <> int (-i)
222
223 -- --------------------------------------------------------------------------
224 -- Registers, whether local (temps) or global
225 --
226 pprReg :: CmmReg -> SDoc
227 pprReg r
228 = case r of
229 CmmLocal local -> pprLocalReg local
230 CmmGlobal global -> pprGlobalReg global
231
232 --
233 -- We only print the type of the local reg if it isn't wordRep
234 --
235 pprLocalReg :: LocalReg -> SDoc
236 pprLocalReg (LocalReg uniq rep)
237 -- = ppr rep <> char '_' <> ppr uniq
238 -- Temp Jan08
239 = char '_' <> ppr uniq <>
240 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
241 then dcolon <> ptr <> ppr rep
242 else dcolon <> ptr <> ppr rep)
243 where
244 ptr = empty
245 --if isGcPtrType rep
246 -- then doubleQuotes (text "ptr")
247 -- else empty
248
249 -- Stack areas
250 pprArea :: Area -> SDoc
251 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
252 pprArea (CallArea id) = pprAreaId id
253
254 pprAreaId :: AreaId -> SDoc
255 pprAreaId Old = text "old"
256 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
257
258 -- needs to be kept in syn with CmmExpr.hs.GlobalReg
259 --
260 pprGlobalReg :: GlobalReg -> SDoc
261 pprGlobalReg gr
262 = case gr of
263 VanillaReg n _ -> char 'R' <> int n
264 -- Temp Jan08
265 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
266 -- VanillaReg n VGcPtr -> char 'P' <> int n
267 FloatReg n -> char 'F' <> int n
268 DoubleReg n -> char 'D' <> int n
269 LongReg n -> char 'L' <> int n
270 Sp -> ptext (sLit "Sp")
271 SpLim -> ptext (sLit "SpLim")
272 Hp -> ptext (sLit "Hp")
273 HpLim -> ptext (sLit "HpLim")
274 CurrentTSO -> ptext (sLit "CurrentTSO")
275 CurrentNursery -> ptext (sLit "CurrentNursery")
276 HpAlloc -> ptext (sLit "HpAlloc")
277 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
278 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
279 GCFun -> ptext (sLit "stg_gc_fun")
280 BaseReg -> ptext (sLit "BaseReg")
281 PicBaseReg -> ptext (sLit "PicBaseReg")
282
283 -----------------------------------------------------------------------------
284
285 commafy :: [SDoc] -> SDoc
286 commafy xs = fsep $ punctuate comma xs