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