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 #-}
36module PprCmmExpr
37    ( pprExpr, pprLit
38    )
39where
40
41import GhcPrelude
42
43import CmmExpr
44
45import Outputable
46import DynFlags
47
48import Data.Maybe
49import Numeric ( fromRat )
50
51-----------------------------------------------------------------------------
52
53instance Outputable CmmExpr where
54    ppr e = pprExpr e
55
56instance Outputable CmmReg where
57    ppr e = pprReg e
58
59instance Outputable CmmLit where
60    ppr l = pprLit l
61
62instance Outputable LocalReg where
63    ppr e = pprLocalReg e
64
65instance Outputable Area where
66    ppr e = pprArea e
67
68instance Outputable GlobalReg where
69    ppr e = pprGlobalReg e
70
71-- --------------------------------------------------------------------------
72-- Expressions
73--
74
75pprExpr :: CmmExpr -> SDoc
76pprExpr e
77    = sdocWithDynFlags $ \dflags ->
78      case e of
79        CmmRegOff reg i ->
80                pprExpr (CmmMachOp (MO_Add rep)
81                           [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
82                where rep = typeWidth (cmmRegType dflags reg)
83        CmmLit lit -> pprLit lit
84        _other     -> pprExpr1 e
85
86-- Here's the precedence table from CmmParse.y:
87-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
88-- %left '|'
89-- %left '^'
90-- %left '&'
91-- %left '>>' '<<'
92-- %left '-' '+'
93-- %left '/' '*' '%'
94-- %right '~'
95
96-- We just cope with the common operators for now, the rest will get
97-- a default conservative behaviour.
98
99-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
100pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
101pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
102   = pprExpr7 x <+> doc <+> pprExpr7 y
103pprExpr1 e = pprExpr7 e
104
105infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
106
107infixMachOp1 (MO_Eq     _) = Just (text "==")
108infixMachOp1 (MO_Ne     _) = Just (text "!=")
109infixMachOp1 (MO_Shl    _) = Just (text "<<")
110infixMachOp1 (MO_U_Shr  _) = Just (text ">>")
111infixMachOp1 (MO_U_Ge   _) = Just (text ">=")
112infixMachOp1 (MO_U_Le   _) = Just (text "<=")
113infixMachOp1 (MO_U_Gt   _) = Just (char '>')
114infixMachOp1 (MO_U_Lt   _) = Just (char '<')
115infixMachOp1 _             = Nothing
116
117-- %left '-' '+'
118pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
119   = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
120pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
121   = pprExpr7 x <+> doc <+> pprExpr8 y
122pprExpr7 e = pprExpr8 e
123
124infixMachOp7 (MO_Add _)  = Just (char '+')
125infixMachOp7 (MO_Sub _)  = Just (char '-')
126infixMachOp7 _           = Nothing
127
128-- %left '/' '*' '%'
129pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
130   = pprExpr8 x <+> doc <+> pprExpr9 y
131pprExpr8 e = pprExpr9 e
132
133infixMachOp8 (MO_U_Quot _) = Just (char '/')
134infixMachOp8 (MO_Mul _)    = Just (char '*')
135infixMachOp8 (MO_U_Rem _)  = Just (char '%')
136infixMachOp8 _             = Nothing
137
138pprExpr9 :: CmmExpr -> SDoc
139pprExpr9 e =
140   case e of
141        CmmLit    lit       -> pprLit1 lit
142        CmmLoad   expr rep  -> ppr rep <> brackets (ppr expr)
143        CmmReg    reg       -> ppr reg
144        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
145        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
146        CmmMachOp mop args  -> genMachOp mop args
147
148genMachOp :: MachOp -> [CmmExpr] -> SDoc
149genMachOp mop args
150   | Just doc <- infixMachOp mop = case args of
151        -- dyadic
152        [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
153
154        -- unary
155        [x]   -> doc <> pprExpr9 x
156
157        _     -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
158                          (pprMachOp mop <+>
159                            parens (hcat $ punctuate comma (map pprExpr args)))
160                          empty
161
162   | isJust (infixMachOp1 mop)
163   || isJust (infixMachOp7 mop)
164   || isJust (infixMachOp8 mop)  = parens (pprExpr (CmmMachOp mop args))
165
166   | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
167        where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
168                                 (show mop))
169                -- replace spaces in (show mop) with underscores,
170
171--
172-- Unsigned ops on the word size of the machine get nice symbols.
173-- All else get dumped in their ugly format.
174--
175infixMachOp :: MachOp -> Maybe SDoc
176infixMachOp mop
177        = case mop of
178            MO_And    _ -> Just $ char '&'
179            MO_Or     _ -> Just $ char '|'
180            MO_Xor    _ -> Just $ char '^'
181            MO_Not    _ -> Just $ char '~'
182            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
183            _ -> Nothing
184
185-- --------------------------------------------------------------------------
186-- Literals.
187--  To minimise line noise we adopt the convention that if the literal
188--  has the natural machine word size, we do not append the type
189--
190pprLit :: CmmLit -> SDoc
191pprLit lit = sdocWithDynFlags $ \dflags ->
192             case lit of
193    CmmInt i rep ->
194        hcat [ (if i < 0 then parens else id)(integer i)
195             , ppUnless (rep == wordWidth dflags) $
196               space <> dcolon <+> ppr rep ]
197
198    CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
199    CmmVec lits        -> char '<' <> commafy (map pprLit lits) <> char '>'
200    CmmLabel clbl      -> ppr clbl
201    CmmLabelOff clbl i -> ppr clbl <> ppr_offset i
202    CmmLabelDiffOff clbl1 clbl2 i _ -> ppr clbl1 <> char '-'
203                                  <> ppr clbl2 <> ppr_offset i
204    CmmBlock id        -> ppr id
205    CmmHighStackMark -> text "<highSp>"
206
207pprLit1 :: CmmLit -> SDoc
208pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
209pprLit1 lit                  = pprLit lit
210
211ppr_offset :: Int -> SDoc
212ppr_offset i
213    | i==0      = empty
214    | i>=0      = char '+' <> int i
215    | otherwise = char '-' <> int (-i)
216
217-- --------------------------------------------------------------------------
218-- Registers, whether local (temps) or global
219--
220pprReg :: CmmReg -> SDoc
221pprReg r
222    = case r of
223        CmmLocal  local  -> pprLocalReg  local
224        CmmGlobal global -> pprGlobalReg global
225
226--
227-- We only print the type of the local reg if it isn't wordRep
228--
229pprLocalReg :: LocalReg -> SDoc
230pprLocalReg (LocalReg uniq rep) = sdocWithDynFlags $ \dflags ->
231--   = ppr rep <> char '_' <> ppr uniq
232-- Temp Jan08
233    char '_' <> pprUnique dflags uniq <>
234       (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
235                    then dcolon <> ptr <> ppr rep
236                    else dcolon <> ptr <> ppr rep)
237   where
238     pprUnique dflags unique =
239        if gopt Opt_SuppressUniques dflags
240            then text "_locVar_"
241            else ppr unique
242     ptr = empty
243         --if isGcPtrType rep
244         --      then doubleQuotes (text "ptr")
245         --      else empty
246
247-- Stack areas
248pprArea :: Area -> SDoc
249pprArea Old        = text "old"
250pprArea (Young id) = hcat [ text "young<", ppr id, text ">" ]
251
252-- needs to be kept in syn with CmmExpr.hs.GlobalReg
253--
254pprGlobalReg :: GlobalReg -> SDoc
255pprGlobalReg gr
256    = case gr of
257        VanillaReg n _ -> char 'R' <> int n
258-- Temp Jan08
259--        VanillaReg n VNonGcPtr -> char 'R' <> int n
260--        VanillaReg n VGcPtr    -> char 'P' <> int n
261        FloatReg   n   -> char 'F' <> int n
262        DoubleReg  n   -> char 'D' <> int n
263        LongReg    n   -> char 'L' <> int n
264        XmmReg     n   -> text "XMM" <> int n
265        YmmReg     n   -> text "YMM" <> int n
266        ZmmReg     n   -> text "ZMM" <> int n
267        Sp             -> text "Sp"
268        SpLim          -> text "SpLim"
269        Hp             -> text "Hp"
270        HpLim          -> text "HpLim"
271        MachSp         -> text "MachSp"
272        UnwindReturnReg-> text "UnwindReturnReg"
273        CCCS           -> text "CCCS"
274        CurrentTSO     -> text "CurrentTSO"
275        CurrentNursery -> text "CurrentNursery"
276        HpAlloc        -> text "HpAlloc"
277        EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
278        GCEnter1       -> text "stg_gc_enter_1"
279        GCFun          -> text "stg_gc_fun"
280        BaseReg        -> text "BaseReg"
281        PicBaseReg     -> text "PicBaseReg"
282
283-----------------------------------------------------------------------------
284
285commafy :: [SDoc] -> SDoc
286commafy xs = fsep $ punctuate comma xs
287