Typofixes in comments and whitespace only [ci skip]
[ghc.git] / compiler / cmm / PprCmmDecl.hs
1 ----------------------------------------------------------------------------
2 --
3 -- Pretty-printing of common Cmm types
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 --
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.
13 --
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.cs.tufts.edu/~nr/c--/index.html. We
17 -- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
18 -- than C--'s bits8 .. bits64.
19 --
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
24 -- cases:
25 -- 1) if a value has wordRep type, the type is not appended in the
26 -- output.
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
29 --
30 -- These conventions produce much more readable Cmm output.
31 --
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
33 --
34
35 {-# OPTIONS_GHC -fno-warn-orphans #-}
36 module PprCmmDecl
37 ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
38 )
39 where
40
41 import GhcPrelude
42
43 import PprCmmExpr
44 import Cmm
45
46 import DynFlags
47 import Outputable
48 import FastString
49
50 import Data.List
51 import System.IO
52
53 -- Temp Jan08
54 import SMRep
55
56
57 pprCmms :: (Outputable info, Outputable g)
58 => [GenCmmGroup CmmStatics info g] -> SDoc
59 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
60 where
61 separator = space $$ text "-------------------" $$ space
62
63 writeCmms :: (Outputable info, Outputable g)
64 => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
65 writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
66
67 -----------------------------------------------------------------------------
68
69 instance (Outputable d, Outputable info, Outputable i)
70 => Outputable (GenCmmDecl d info i) where
71 ppr t = pprTop t
72
73 instance Outputable CmmStatics where
74 ppr = pprStatics
75
76 instance Outputable CmmStatic where
77 ppr = pprStatic
78
79 instance Outputable CmmInfoTable where
80 ppr = pprInfoTable
81
82
83 -----------------------------------------------------------------------------
84
85 pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
86 => GenCmmGroup d info g -> SDoc
87 pprCmmGroup tops
88 = vcat $ intersperse blankLine $ map pprTop tops
89
90 -- --------------------------------------------------------------------------
91 -- Top level `procedure' blocks.
92 --
93 pprTop :: (Outputable d, Outputable info, Outputable i)
94 => GenCmmDecl d info i -> SDoc
95
96 pprTop (CmmProc info lbl live graph)
97
98 = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live
99 , nest 8 $ lbrace <+> ppr info $$ rbrace
100 , nest 4 $ ppr graph
101 , rbrace ]
102
103 -- --------------------------------------------------------------------------
104 -- We follow [1], 4.5
105 --
106 -- section "data" { ... }
107 --
108 pprTop (CmmData section ds) =
109 (hang (pprSection section <+> lbrace) 4 (ppr ds))
110 $$ rbrace
111
112 -- --------------------------------------------------------------------------
113 -- Info tables.
114
115 pprInfoTable :: CmmInfoTable -> SDoc
116 pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
117 , cit_prof = prof_info
118 , cit_srt = srt })
119 = vcat [ text "label: " <> ppr lbl
120 , text "rep: " <> ppr rep
121 , case prof_info of
122 NoProfilingInfo -> empty
123 ProfilingInfo ct cd ->
124 vcat [ text "type: " <> pprWord8String ct
125 , text "desc: " <> pprWord8String cd ]
126 , text "srt: " <> ppr srt ]
127
128 instance Outputable ForeignHint where
129 ppr NoHint = empty
130 ppr SignedHint = quotes(text "signed")
131 -- ppr AddrHint = quotes(text "address")
132 -- Temp Jan08
133 ppr AddrHint = (text "PtrHint")
134
135 -- --------------------------------------------------------------------------
136 -- Static data.
137 -- Strings are printed as C strings, and we print them as I8[],
138 -- following C--
139 --
140 pprStatics :: CmmStatics -> SDoc
141 pprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
142
143 pprStatic :: CmmStatic -> SDoc
144 pprStatic s = case s of
145 CmmStaticLit lit -> nest 4 $ text "const" <+> pprLit lit <> semi
146 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
147 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
148
149 -- --------------------------------------------------------------------------
150 -- data sections
151 --
152 pprSection :: Section -> SDoc
153 pprSection (Section t suffix) =
154 section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)
155 where
156 section = text "section"
157
158 pprSectionType :: SectionType -> SDoc
159 pprSectionType s = doubleQuotes (ptext t)
160 where
161 t = case s of
162 Text -> sLit "text"
163 Data -> sLit "data"
164 ReadOnlyData -> sLit "readonly"
165 ReadOnlyData16 -> sLit "readonly16"
166 RelocatableReadOnlyData
167 -> sLit "relreadonly"
168 UninitialisedData -> sLit "uninitialised"
169 CString -> sLit "cstring"
170 OtherSection s' -> sLit s' -- Not actually a literal though.