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