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