never executed always true always false
1 {-# LANGUAGE GADTs #-}
2 {-# LANGUAGE TypeFamilies #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE FlexibleInstances #-}
6 {-# LANGUAGE LambdaCase #-}
7
8 {-# OPTIONS_GHC -fno-warn-orphans #-}
9
10 ----------------------------------------------------------------------------
11 --
12 -- Pretty-printing of Cmm as (a superset of) C--
13 --
14 -- (c) The University of Glasgow 2004-2006
15 --
16 -----------------------------------------------------------------------------
17 --
18 -- This is where we walk over CmmNode emitting an external representation,
19 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
20 -- is the "External Core" for the Cmm layer.
21 --
22 -- As such, this should be a well-defined syntax: we want it to look nice.
23 -- Thus, we try wherever possible to use syntax defined in [1],
24 -- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
25 -- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
26 -- than C--'s bits8 .. bits64.
27 --
28 -- We try to ensure that all information available in the abstract
29 -- syntax is reproduced, or reproducible, in the concrete syntax.
30 -- Data that is not in printed out can be reconstructed according to
31 -- conventions used in the pretty printer. There are at least two such
32 -- cases:
33 -- 1) if a value has wordRep type, the type is not appended in the
34 -- output.
35 -- 2) MachOps that operate over wordRep type are printed in a
36 -- C-style, rather than as their internal MachRep name.
37 --
38 -- These conventions produce much more readable Cmm output.
39 --
40 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
41
42 module GHC.Cmm.Ppr
43 ( module GHC.Cmm.Ppr.Decl
44 , module GHC.Cmm.Ppr.Expr
45 )
46 where
47
48 import GHC.Prelude hiding (succ)
49
50 import GHC.Platform
51 import GHC.Cmm.CLabel
52 import GHC.Cmm
53 import GHC.Cmm.Utils
54 import GHC.Cmm.Switch
55 import GHC.Data.FastString
56 import GHC.Utils.Outputable
57 import GHC.Cmm.Ppr.Decl
58 import GHC.Cmm.Ppr.Expr
59 import GHC.Utils.Constants (debugIsOn)
60
61 import GHC.Types.Basic
62 import GHC.Cmm.Dataflow.Block
63 import GHC.Cmm.Dataflow.Graph
64
65 -------------------------------------------------
66 -- Outputable instances
67 instance OutputableP Platform InfoProvEnt where
68 pdoc platform (InfoProvEnt clabel _ _ _ _) = pdoc platform clabel
69
70 instance Outputable CmmStackInfo where
71 ppr = pprStackInfo
72
73 instance OutputableP Platform CmmTopInfo where
74 pdoc = pprTopInfo
75
76
77 instance OutputableP Platform (CmmNode e x) where
78 pdoc = pprNode
79
80 instance Outputable Convention where
81 ppr = pprConvention
82
83 instance Outputable ForeignConvention where
84 ppr = pprForeignConvention
85
86 instance OutputableP Platform ForeignTarget where
87 pdoc = pprForeignTarget
88
89 instance Outputable CmmReturnInfo where
90 ppr = pprReturnInfo
91
92 instance OutputableP Platform (Block CmmNode C C) where
93 pdoc = pprBlock
94 instance OutputableP Platform (Block CmmNode C O) where
95 pdoc = pprBlock
96 instance OutputableP Platform (Block CmmNode O C) where
97 pdoc = pprBlock
98 instance OutputableP Platform (Block CmmNode O O) where
99 pdoc = pprBlock
100
101 instance OutputableP Platform (Graph CmmNode e x) where
102 pdoc = pprGraph
103
104 instance OutputableP Platform CmmGraph where
105 pdoc = pprCmmGraph
106
107 ----------------------------------------------------------
108 -- Outputting types Cmm contains
109
110 pprStackInfo :: CmmStackInfo -> SDoc
111 pprStackInfo (StackInfo {arg_space=arg_space}) =
112 text "arg_space: " <> ppr arg_space
113
114 pprTopInfo :: Platform -> CmmTopInfo -> SDoc
115 pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
116 vcat [text "info_tbls: " <> pdoc platform info_tbl,
117 text "stack_info: " <> ppr stack_info]
118
119 ----------------------------------------------------------
120 -- Outputting blocks and graphs
121
122 pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
123 => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
124 pprBlock platform block
125 = foldBlockNodesB3 ( ($$) . pdoc platform
126 , ($$) . (nest 4) . pdoc platform
127 , ($$) . (nest 4) . pdoc platform
128 )
129 block
130 empty
131
132 pprGraph :: Platform -> Graph CmmNode e x -> SDoc
133 pprGraph platform = \case
134 GNil -> empty
135 GUnit block -> pdoc platform block
136 GMany entry body exit ->
137 text "{"
138 $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
139 $$ text "}"
140 where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
141 => MaybeO ex (Block CmmNode e x) -> SDoc
142 pprMaybeO NothingO = empty
143 pprMaybeO (JustO block) = pdoc platform block
144
145 pprCmmGraph :: Platform -> CmmGraph -> SDoc
146 pprCmmGraph platform g
147 = text "{" <> text "offset"
148 $$ nest 2 (vcat $ map (pdoc platform) blocks)
149 $$ text "}"
150 where blocks = revPostorder g
151 -- revPostorder has the side-effect of discarding unreachable code,
152 -- so pretty-printed Cmm will omit any unreachable blocks. This can
153 -- sometimes be confusing.
154
155 ---------------------------------------------
156 -- Outputting CmmNode and types which it contains
157
158 pprConvention :: Convention -> SDoc
159 pprConvention (NativeNodeCall {}) = text "<native-node-call-convention>"
160 pprConvention (NativeDirectCall {}) = text "<native-direct-call-convention>"
161 pprConvention (NativeReturn {}) = text "<native-ret-convention>"
162 pprConvention Slow = text "<slow-convention>"
163 pprConvention GC = text "<gc-convention>"
164
165 pprForeignConvention :: ForeignConvention -> SDoc
166 pprForeignConvention (ForeignConvention c args res ret) =
167 doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res <+> ppr ret
168
169 pprReturnInfo :: CmmReturnInfo -> SDoc
170 pprReturnInfo CmmMayReturn = empty
171 pprReturnInfo CmmNeverReturns = text "never returns"
172
173 pprForeignTarget :: Platform -> ForeignTarget -> SDoc
174 pprForeignTarget platform (ForeignTarget fn c) = ppr c <+> ppr_target fn
175 where
176 ppr_target :: CmmExpr -> SDoc
177 ppr_target t@(CmmLit _) = pdoc platform t
178 ppr_target fn' = parens (pdoc platform fn')
179
180 pprForeignTarget platform (PrimTarget op)
181 -- HACK: We're just using a ForeignLabel to get this printed, the label
182 -- might not really be foreign.
183 = pdoc platform
184 (CmmLabel (mkForeignLabel
185 (mkFastString (show op))
186 Nothing ForeignLabelInThisPackage IsFunction))
187
188 pprNode :: Platform -> CmmNode e x -> SDoc
189 pprNode platform node = pp_node <+> pp_debug
190 where
191 pp_node :: SDoc
192 pp_node = case node of
193 -- label:
194 CmmEntry id tscope ->
195 (sdocOption sdocSuppressUniques $ \case
196 True -> text "_lbl_"
197 False -> ppr id
198 )
199 <> colon
200 <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope)
201
202 -- // text
203 CmmComment s -> text "//" <+> ftext s
204
205 -- //tick bla<...>
206 CmmTick t -> ppUnlessOption sdocSuppressTicks
207 (text "//tick" <+> ppr t)
208
209 -- unwind reg = expr;
210 CmmUnwind regs ->
211 text "unwind "
212 <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> pdoc platform e) regs) <> semi
213
214 -- reg = expr;
215 CmmAssign reg expr -> ppr reg <+> equals <+> pdoc platform expr <> semi
216
217 -- rep[lv] = expr;
218 CmmStore lv expr -> rep <> brackets (pdoc platform lv) <+> equals <+> pdoc platform expr <> semi
219 where
220 rep = ppr ( cmmExprType platform expr )
221
222 -- call "ccall" foo(x, y)[r1, r2];
223 -- ToDo ppr volatile
224 CmmUnsafeForeignCall target results args ->
225 hsep [ ppUnless (null results) $
226 parens (commafy $ map ppr results) <+> equals,
227 text "call",
228 pdoc platform target <> parens (commafy $ map (pdoc platform) args) <> semi]
229
230 -- goto label;
231 CmmBranch ident -> text "goto" <+> ppr ident <> semi
232
233 -- if (expr) goto t; else goto f;
234 CmmCondBranch expr t f l ->
235 hsep [ text "if"
236 , parens (pdoc platform expr)
237 , case l of
238 Nothing -> empty
239 Just b -> parens (text "likely:" <+> ppr b)
240 , text "goto"
241 , ppr t <> semi
242 , text "else goto"
243 , ppr f <> semi
244 ]
245
246 CmmSwitch expr ids ->
247 hang (hsep [ text "switch"
248 , range
249 , if isTrivialCmmExpr expr
250 then pdoc platform expr
251 else parens (pdoc platform expr)
252 , text "{"
253 ])
254 4 (vcat (map ppCase cases) $$ def) $$ rbrace
255 where
256 (cases, mbdef) = switchTargetsFallThrough ids
257 ppCase (is,l) = hsep
258 [ text "case"
259 , commafy $ map integer is
260 , text ": goto"
261 , ppr l <> semi
262 ]
263 def | Just l <- mbdef = hsep
264 [ text "default:"
265 , braces (text "goto" <+> ppr l <> semi)
266 ]
267 | otherwise = empty
268
269 range = brackets $ hsep [integer lo, text "..", integer hi]
270 where (lo,hi) = switchTargetsRange ids
271
272 CmmCall tgt k regs out res updfr_off ->
273 hcat [ text "call", space
274 , pprFun tgt, parens (interpp'SP regs), space
275 , returns <+>
276 text "args: " <> ppr out <> comma <+>
277 text "res: " <> ppr res <> comma <+>
278 text "upd: " <> ppr updfr_off
279 , semi ]
280 where pprFun f@(CmmLit _) = pdoc platform f
281 pprFun f = parens (pdoc platform f)
282
283 returns
284 | Just r <- k = text "returns to" <+> ppr r <> comma
285 | otherwise = empty
286
287 CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
288 hcat $ if i then [text "interruptible", space] else [] ++
289 [ text "foreign call", space
290 , pdoc platform t, text "(...)", space
291 , text "returns to" <+> ppr s
292 <+> text "args:" <+> parens (pdoc platform as)
293 <+> text "ress:" <+> parens (ppr rs)
294 , text "ret_args:" <+> ppr a
295 , text "ret_off:" <+> ppr u
296 , semi ]
297
298 pp_debug :: SDoc
299 pp_debug =
300 if not debugIsOn then empty
301 else case node of
302 CmmEntry {} -> empty -- Looks terrible with text " // CmmEntry"
303 CmmComment {} -> empty -- Looks also terrible with text " // CmmComment"
304 CmmTick {} -> empty
305 CmmUnwind {} -> text " // CmmUnwind"
306 CmmAssign {} -> text " // CmmAssign"
307 CmmStore {} -> text " // CmmStore"
308 CmmUnsafeForeignCall {} -> text " // CmmUnsafeForeignCall"
309 CmmBranch {} -> text " // CmmBranch"
310 CmmCondBranch {} -> text " // CmmCondBranch"
311 CmmSwitch {} -> text " // CmmSwitch"
312 CmmCall {} -> text " // CmmCall"
313 CmmForeignCall {} -> text " // CmmForeignCall"
314
315 commafy :: [SDoc] -> SDoc
316 commafy xs = hsep $ punctuate comma xs