1 ----------------------------------------------------------------------------
3 -- Pretty-printing of old-style Cmm as (a superset of) C--
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
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.
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.
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
25 -- 1) if a value has wordRep type, the type is not appended in the
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
30 -- These conventions produce much more readable Cmm output.
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
57 -----------------------------------------------------------------------------
59 instance (Outputable instr) => Outputable (ListGraph instr) where
60 ppr (ListGraph blocks) = vcat (map ppr blocks)
62 instance (Outputable instr) => Outputable (GenBasicBlock instr) where
65 instance Outputable CmmStmt where
68 instance Outputable CmmInfo where
72 -- --------------------------------------------------------------------------
73 instance Outputable CmmSafety where
74 ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
75 ppr CmmInterruptible = ptext (sLit "_interruptible_call_")
76 ppr (CmmSafe srt) = ppr srt
78 -- --------------------------------------------------------------------------
79 -- Info tables. The current pretty printer needs refinement
80 -- but will work for now.
82 -- For ideas on how to refine it, they used to be printed in the
83 -- style of C--'s 'stackdata' declaration, just inside the proc body,
84 -- and were labelled with the procedure name ++ "_info".
85 pprInfo :: CmmInfo -> SDoc
86 pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
87 vcat [{-ptext (sLit "gc_target: ") <>
88 maybe (ptext (sLit "<none>")) ppr gc_target,-}
89 ptext (sLit "update_frame: ") <>
90 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
91 pprInfo (CmmInfo _gc_target update_frame info_table@(CmmInfoTable _ _ _ _)) =
92 vcat [{-ptext (sLit "gc_target: ") <>
93 maybe (ptext (sLit "<none>")) ppr gc_target,-}
94 ptext (sLit "update_frame: ") <>
95 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
99 -- --------------------------------------------------------------------------
100 -- Basic blocks look like assembly blocks.
101 -- lbl: stmt ; stmt ; ..
102 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
103 pprBBlock (BasicBlock ident stmts) =
104 hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
106 -- --------------------------------------------------------------------------
107 -- Statements. C-- usually, exceptions to this should be obvious.
109 pprStmt :: CmmStmt -> SDoc
110 pprStmt stmt = case stmt of
116 CmmComment s -> text "//" <+> ftext s
119 CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
122 CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
124 rep = ppr ( cmmExprType expr )
126 -- call "ccall" foo(x, y)[r1, r2];
128 CmmCall (CmmCallee fn cconv) results args safety ret ->
129 sep [ pp_lhs <+> pp_conv
130 , nest 2 (pprExpr9 fn <>
131 parens (commafy (map ppr_ar args)))
132 <> brackets (ppr safety)
133 , case ret of CmmMayReturn -> empty
134 CmmNeverReturns -> ptext $ sLit (" never returns")
137 pp_lhs | null results = empty
138 | otherwise = commafy (map ppr_ar results) <+> equals
139 -- Don't print the hints on a native C-- call
140 ppr_ar (CmmHinted ar k) = case cconv of
141 CmmCallConv -> ppr ar
143 pp_conv = case cconv of
145 _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
147 -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
148 CmmCall (CmmPrim op) results args safety ret ->
149 pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
150 results args safety ret)
152 -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
153 -- use one to get the label printed.
154 lbl = CmmLabel (mkForeignLabel
155 (mkFastString (show op))
156 Nothing ForeignLabelInThisPackage IsFunction)
158 CmmBranch ident -> genBranch ident
159 CmmCondBranch expr ident -> genCondBranch expr ident
160 CmmJump expr params -> genJump expr params
161 CmmReturn params -> genReturn params
162 CmmSwitch arg ids -> genSwitch arg ids
164 -- Just look like a tuple, since it was a tuple before
165 -- ... is that a good idea? --Isaac Dupree
166 instance (Outputable a) => Outputable (CmmHinted a) where
167 ppr (CmmHinted a k) = ppr (a, k)
169 pprUpdateFrame :: UpdateFrame -> SDoc
170 pprUpdateFrame (UpdateFrame expr args) =
171 hcat [ ptext (sLit "jump")
173 , if isTrivialCmmExpr expr
176 CmmLoad (CmmReg _) _ -> pprExpr expr
177 _ -> parens (pprExpr expr)
179 , parens ( commafy $ map ppr args ) ]
182 -- --------------------------------------------------------------------------
183 -- goto local label. [1], section 6.6
187 genBranch :: BlockId -> SDoc
189 ptext (sLit "goto") <+> ppr ident <> semi
191 -- --------------------------------------------------------------------------
192 -- Conditional. [1], section 6.4
194 -- if (expr) { goto lbl; }
196 genCondBranch :: CmmExpr -> BlockId -> SDoc
197 genCondBranch expr ident =
198 hsep [ ptext (sLit "if")
200 , ptext (sLit "goto")
201 , ppr ident <> semi ]
203 -- --------------------------------------------------------------------------
204 -- A tail call. [1], Section 6.9
206 -- jump foo(a, b, c);
208 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
210 hcat [ ptext (sLit "jump")
212 , if isTrivialCmmExpr expr
215 CmmLoad (CmmReg _) _ -> pprExpr expr
216 _ -> parens (pprExpr expr)
218 , parens ( commafy $ map ppr args )
222 -- --------------------------------------------------------------------------
223 -- Return from a function. [1], Section 6.8.2 of version 1.128
227 genReturn :: [CmmHinted CmmExpr] -> SDoc
229 hcat [ ptext (sLit "return")
231 , parens ( commafy $ map ppr args )
234 -- --------------------------------------------------------------------------
235 -- Tabled jump to local label
237 -- The syntax is from [1], section 6.5
239 -- switch [0 .. n] (expr) { case ... ; }
241 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
242 genSwitch expr maybe_ids
244 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
246 in hang (hcat [ ptext (sLit "switch [0 .. ")
247 , int (length maybe_ids - 1)
249 , if isTrivialCmmExpr expr
251 else parens (pprExpr expr)
254 4 (vcat ( map caseify pairs )) $$ rbrace
257 snds a b = (snd a) == (snd b)
259 caseify :: [(Int,Maybe BlockId)] -> SDoc
260 caseify ixs@((_,Nothing):_)
261 = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
262 <> ptext (sLit " */")
264 = let (is,ids) = unzip as
265 in hsep [ ptext (sLit "case")
266 , hcat (punctuate comma (map int is))
267 , ptext (sLit ": goto")
268 , ppr (head [ id | Just id <- ids]) <> semi ]
270 -----------------------------------------------------------------------------
272 commafy :: [SDoc] -> SDoc
273 commafy xs = fsep $ punctuate comma xs