Remove unnecessary LANGUAGE pragma
[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.cminusminus.org/. We differ
17 -- 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 PprCmmExpr
42 import Cmm
43
44 import DynFlags
45 import Outputable
46 import FastString
47
48 import Data.List
49 import System.IO
50
51 -- Temp Jan08
52 import SMRep
53 #include "../includes/rts/storage/FunTypes.h"
54
55
56 pprCmms :: (Outputable info, Outputable g)
57 => [GenCmmGroup CmmStatics info g] -> SDoc
58 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
59 where
60 separator = space $$ ptext (sLit "-------------------") $$ space
61
62 writeCmms :: (Outputable info, Outputable g)
63 => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
64 writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
65
66 -----------------------------------------------------------------------------
67
68 instance (Outputable d, Outputable info, Outputable i)
69 => Outputable (GenCmmDecl d info i) where
70 ppr t = pprTop t
71
72 instance Outputable CmmStatics where
73 ppr = pprStatics
74
75 instance Outputable CmmStatic where
76 ppr = pprStatic
77
78 instance Outputable CmmInfoTable where
79 ppr = pprInfoTable
80
81
82 -----------------------------------------------------------------------------
83
84 pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
85 => GenCmmGroup d info g -> SDoc
86 pprCmmGroup tops
87 = vcat $ intersperse blankLine $ map pprTop tops
88
89 -- --------------------------------------------------------------------------
90 -- Top level `procedure' blocks.
91 --
92 pprTop :: (Outputable d, Outputable info, Outputable i)
93 => GenCmmDecl d info i -> SDoc
94
95 pprTop (CmmProc info lbl live graph)
96
97 = vcat [ ppr lbl <> lparen <> rparen <+> ptext (sLit "// ") <+> ppr live
98 , nest 8 $ lbrace <+> ppr info $$ rbrace
99 , nest 4 $ ppr graph
100 , rbrace ]
101
102 -- --------------------------------------------------------------------------
103 -- We follow [1], 4.5
104 --
105 -- section "data" { ... }
106 --
107 pprTop (CmmData section ds) =
108 (hang (pprSection section <+> lbrace) 4 (ppr ds))
109 $$ rbrace
110
111 -- --------------------------------------------------------------------------
112 -- Info tables.
113
114 pprInfoTable :: CmmInfoTable -> SDoc
115 pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
116 , cit_prof = prof_info
117 , cit_srt = _srt })
118 = vcat [ ptext (sLit "label:") <+> ppr lbl
119 , ptext (sLit "rep:") <> ppr rep
120 , case prof_info of
121 NoProfilingInfo -> empty
122 ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
123 , ptext (sLit "desc: ") <> pprWord8String cd ] ]
124
125 instance Outputable C_SRT where
126 ppr NoC_SRT = ptext (sLit "_no_srt_")
127 ppr (C_SRT label off bitmap)
128 = parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
129
130 instance Outputable ForeignHint where
131 ppr NoHint = empty
132 ppr SignedHint = quotes(text "signed")
133 -- ppr AddrHint = quotes(text "address")
134 -- Temp Jan08
135 ppr AddrHint = (text "PtrHint")
136
137 -- --------------------------------------------------------------------------
138 -- Static data.
139 -- Strings are printed as C strings, and we print them as I8[],
140 -- following C--
141 --
142 pprStatics :: CmmStatics -> SDoc
143 pprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
144
145 pprStatic :: CmmStatic -> SDoc
146 pprStatic s = case s of
147 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
148 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
149 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
150
151 -- --------------------------------------------------------------------------
152 -- data sections
153 --
154 pprSection :: Section -> SDoc
155 pprSection s = case s of
156 Text -> section <+> doubleQuotes (ptext (sLit "text"))
157 Data -> section <+> doubleQuotes (ptext (sLit "data"))
158 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
159 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
160 RelocatableReadOnlyData
161 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
162 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
163 OtherSection s' -> section <+> doubleQuotes (text s')
164 where
165 section = ptext (sLit "section")