1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------
--
-- Pretty-printing of common Cmm types
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
--
-- This is where we walk over Cmm emitting an external representation,
-- suitable for parsing, in a syntax strongly reminiscent of C--. This
-- is the "External Core" for the Cmm layer.
--
-- As such, this should be a well-defined syntax: we want it to look nice.
-- Thus, we try wherever possible to use syntax defined in [1],
-- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
-- slightly, in some cases. For one, we use I8 .. I64 for types, rather
-- than C--'s bits8 .. bits64.
--
-- We try to ensure that all information available in the abstract
-- syntax is reproduced, or reproducible, in the concrete syntax.
-- Data that is not in printed out can be reconstructed according to
-- conventions used in the pretty printer. There are at least two such
-- cases:
-- 1) if a value has wordRep type, the type is not appended in the
-- output.
-- 2) MachOps that operate over wordRep type are printed in a
-- C-style, rather than as their internal MachRep name.
--
-- These conventions produce much more readable Cmm output.
--
-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PprCmmDecl
( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
)
where
import PprCmmExpr
import Cmm
import DynFlags
import Outputable
import FastString
import Data.List
import System.IO
-- Temp Jan08
import SMRep
#include "../includes/rts/storage/FunTypes.h"
pprCmms :: (Outputable info, Outputable g)
=> [GenCmmGroup CmmStatics info g] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
where
separator = space $$ ptext (sLit "-------------------") $$ space
writeCmms :: (Outputable info, Outputable g)
=> DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
-----------------------------------------------------------------------------
instance (Outputable d, Outputable info, Outputable i)
=> Outputable (GenCmmDecl d info i) where
ppr t = pprTop t
instance Outputable CmmStatics where
ppr = pprStatics
instance Outputable CmmStatic where
ppr = pprStatic
instance Outputable CmmInfoTable where
ppr = pprInfoTable
-----------------------------------------------------------------------------
pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
=> GenCmmGroup d info g -> SDoc
pprCmmGroup tops
= vcat $ intersperse blankLine $ map pprTop tops
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
pprTop :: (Outputable d, Outputable info, Outputable i)
=> GenCmmDecl d info i -> SDoc
pprTop (CmmProc info lbl live graph)
= vcat [ ppr lbl <> lparen <> rparen <+> ptext (sLit "// ") <+> ppr live
, nest 8 $ lbrace <+> ppr info $$ rbrace
, nest 4 $ ppr graph
, rbrace ]
-- --------------------------------------------------------------------------
-- We follow [1], 4.5
--
-- section "data" { ... }
--
pprTop (CmmData section ds) =
(hang (pprSection section <+> lbrace) 4 (ppr ds))
$$ rbrace
-- --------------------------------------------------------------------------
-- Info tables.
pprInfoTable :: CmmInfoTable -> SDoc
pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
, cit_prof = prof_info
, cit_srt = _srt })
= vcat [ ptext (sLit "label:") <+> ppr lbl
, ptext (sLit "rep:") <> ppr rep
, case prof_info of
NoProfilingInfo -> empty
ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
, ptext (sLit "desc: ") <> pprWord8String cd ] ]
instance Outputable C_SRT where
ppr NoC_SRT = ptext (sLit "_no_srt_")
ppr (C_SRT label off bitmap)
= parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
instance Outputable ForeignHint where
ppr NoHint = empty
ppr SignedHint = quotes(text "signed")
-- ppr AddrHint = quotes(text "address")
-- Temp Jan08
ppr AddrHint = (text "PtrHint")
-- --------------------------------------------------------------------------
-- Static data.
-- Strings are printed as C strings, and we print them as I8[],
-- following C--
--
pprStatics :: CmmStatics -> SDoc
pprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
pprStatic :: CmmStatic -> SDoc
pprStatic s = case s of
CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
-- --------------------------------------------------------------------------
-- data sections
--
pprSection :: Section -> SDoc
pprSection (Section t suffix) =
section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)
where
section = ptext (sLit "section")
pprSectionType :: SectionType -> SDoc
pprSectionType s = doubleQuotes (ptext t)
where
t = case s of
Text -> sLit "text"
Data -> sLit "data"
ReadOnlyData -> sLit "readonly"
ReadOnlyData16 -> sLit "readonly16"
RelocatableReadOnlyData
-> sLit "relreadonly"
UninitialisedData -> sLit "uninitialised"
OtherSection s' -> sLit s' -- Not actually a literal though.
|
