1 ----------------------------------------------------------------------------
3 -- Pretty-printing of common Cmm types
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
36 ( writeCmms, pprCmms, pprCmm, pprSection, pprStatic
54 #include "../includes/rts/storage/FunTypes.h"
57 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
58 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
60 separator = space $$ ptext (sLit "-------------------") $$ space
62 writeCmms :: (Outputable info, Outputable g) => Handle -> [GenCmm CmmStatic info g] -> IO ()
63 writeCmms handle cmms = printForC handle (pprCmms cmms)
65 -----------------------------------------------------------------------------
67 instance (Outputable d, Outputable info, Outputable g)
68 => Outputable (GenCmm d info g) where
71 instance (Outputable d, Outputable info, Outputable i)
72 => Outputable (GenCmmTop d info i) where
75 instance Outputable CmmStatic where
78 instance Outputable CmmInfoTable where
79 ppr e = pprInfoTable e
82 -----------------------------------------------------------------------------
84 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
85 pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
87 -- --------------------------------------------------------------------------
88 -- Top level `procedure' blocks.
90 pprTop :: (Outputable d, Outputable info, Outputable i)
91 => GenCmmTop d info i -> SDoc
93 pprTop (CmmProc info lbl graph)
95 = vcat [ pprCLabel lbl <> lparen <> rparen
96 , nest 8 $ lbrace <+> ppr info $$ rbrace
100 -- --------------------------------------------------------------------------
101 -- We follow [1], 4.5
103 -- section "data" { ... }
105 pprTop (CmmData section ds) =
106 (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
109 -- --------------------------------------------------------------------------
112 pprInfoTable :: CmmInfoTable -> SDoc
113 pprInfoTable CmmNonInfoTable = empty
114 pprInfoTable (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info) =
115 vcat [ptext (sLit "has static closure: ") <> ppr stat_clos <+>
116 ptext (sLit "type: ") <> pprLit closure_type,
117 ptext (sLit "desc: ") <> pprLit closure_desc,
118 ptext (sLit "tag: ") <> integer (toInteger tag),
121 pprTypeInfo :: ClosureTypeInfo -> SDoc
122 pprTypeInfo (ConstrInfo layout constr descr) =
123 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
124 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
125 ptext (sLit "constructor: ") <> integer (toInteger constr),
127 pprTypeInfo (FunInfo layout srt arity _args slow_entry) =
128 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
129 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
130 ptext (sLit "srt: ") <> ppr srt,
132 ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
134 ptext (sLit "arity: ") <> integer (toInteger arity),
135 --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
136 ptext (sLit "slow: ") <> pprLit slow_entry
138 pprTypeInfo (ThunkInfo layout srt) =
139 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
140 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
141 ptext (sLit "srt: ") <> ppr srt]
142 pprTypeInfo (ThunkSelectorInfo offset srt) =
143 vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
144 ptext (sLit "srt: ") <> ppr srt]
145 pprTypeInfo (ContInfo stack srt) =
146 vcat [ptext (sLit "stack: ") <> ppr stack,
147 ptext (sLit "srt: ") <> ppr srt]
150 argDescrType :: ArgDescr -> StgHalfWord
151 -- The "argument type" RTS field type
152 argDescrType (ArgSpec n) = n
153 argDescrType (ArgGen liveness)
154 | isBigLiveness liveness = ARG_GEN_BIG
155 | otherwise = ARG_GEN
158 isBigLiveness :: Liveness -> Bool
159 isBigLiveness (BigLiveness _) = True
160 isBigLiveness (SmallLiveness _) = False
162 instance Outputable ForeignHint where
164 ppr SignedHint = quotes(text "signed")
165 -- ppr AddrHint = quotes(text "address")
167 ppr AddrHint = (text "PtrHint")
169 -- --------------------------------------------------------------------------
171 -- Strings are printed as C strings, and we print them as I8[],
174 pprStatic :: CmmStatic -> SDoc
175 pprStatic s = case s of
176 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
177 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
178 CmmAlign i -> nest 4 $ text "align" <+> int i
179 CmmDataLabel clbl -> pprCLabel clbl <> colon
180 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
182 -- --------------------------------------------------------------------------
185 pprSection :: Section -> SDoc
186 pprSection s = case s of
187 Text -> section <+> doubleQuotes (ptext (sLit "text"))
188 Data -> section <+> doubleQuotes (ptext (sLit "data"))
189 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
190 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
191 RelocatableReadOnlyData
192 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
193 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
194 OtherSection s' -> section <+> doubleQuotes (text s')
196 section = ptext (sLit "section")