PprCmmExpr.hs 9.88 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
----------------------------------------------------------------------------
--
-- Pretty-printing of common Cmm types
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

--
-- This is where we walk over Cmm emitting an external representation,
-- suitable for parsing, in a syntax strongly reminiscent of C--. This
-- is the "External Core" for the Cmm layer.
--
-- As such, this should be a well-defined syntax: we want it to look nice.
-- Thus, we try wherever possible to use syntax defined in [1],
-- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
-- slightly, in some cases. For one, we use I8 .. I64 for types, rather
-- than C--'s bits8 .. bits64.
--
-- We try to ensure that all information available in the abstract
-- syntax is reproduced, or reproducible, in the concrete syntax.
-- Data that is not in printed out can be reconstructed according to
-- conventions used in the pretty printer. There are at least two such
-- cases:
--      1) if a value has wordRep type, the type is not appended in the
--      output.
--      2) MachOps that operate over wordRep type are printed in a
--      C-style, rather than as their internal MachRep name.
--
-- These conventions produce much more readable Cmm output.
--
-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--

Ian Lynagh's avatar
Ian Lynagh committed
35 36 37 38 39 40 41
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

42 43 44 45 46 47 48 49 50 51
module PprCmmExpr
    ( pprExpr, pprLit
    , pprExpr9 {-only to import in OldPprCmm. When it dies, remove the export -}
    )
where

import CmmExpr
import CLabel

import Outputable
52
import Platform
53 54 55
import FastString

import Data.Maybe
56
import Numeric ( fromRat )
57 58 59

-----------------------------------------------------------------------------

60 61
instance PlatformOutputable CmmExpr where
    pprPlatform = pprExpr
62 63 64 65

instance Outputable CmmReg where
    ppr e = pprReg e

66 67
instance PlatformOutputable CmmLit where
    pprPlatform = pprLit
68 69 70

instance Outputable LocalReg where
    ppr e = pprLocalReg e
71 72
instance PlatformOutputable LocalReg where
    pprPlatform _ = ppr
73 74 75 76 77 78 79 80 81 82 83

instance Outputable Area where
    ppr e = pprArea e

instance Outputable GlobalReg where
    ppr e = pprGlobalReg e

-- --------------------------------------------------------------------------
-- Expressions
--

84 85
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr platform e
86 87
    = case e of
        CmmRegOff reg i -> 
88
		pprExpr platform (CmmMachOp (MO_Add rep)
89 90
			   [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
		where rep = typeWidth (cmmRegType reg)
91 92
	CmmLit lit -> pprLit platform lit
	_other     -> pprExpr1 platform e
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107

-- Here's the precedence table from CmmParse.y:
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
-- %left '|'
-- %left '^'
-- %left '&'
-- %left '>>' '<<'
-- %left '-' '+'
-- %left '/' '*' '%'
-- %right '~'

-- We just cope with the common operators for now, the rest will get
-- a default conservative behaviour.

-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
108 109 110 111
pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
pprExpr1 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
   = pprExpr7 platform x <+> doc <+> pprExpr7 platform y
pprExpr1 platform e = pprExpr7 platform e
112 113 114 115 116 117 118 119 120 121 122 123 124 125

infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc

infixMachOp1 (MO_Eq     _) = Just (ptext (sLit "=="))
infixMachOp1 (MO_Ne     _) = Just (ptext (sLit "!="))
infixMachOp1 (MO_Shl    _) = Just (ptext (sLit "<<"))
infixMachOp1 (MO_U_Shr  _) = Just (ptext (sLit ">>"))
infixMachOp1 (MO_U_Ge   _) = Just (ptext (sLit ">="))
infixMachOp1 (MO_U_Le   _) = Just (ptext (sLit "<="))
infixMachOp1 (MO_U_Gt   _) = Just (char '>')
infixMachOp1 (MO_U_Lt   _) = Just (char '<')
infixMachOp1 _             = Nothing

-- %left '-' '+'
126 127 128 129 130
pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
   = pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
pprExpr7 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
   = pprExpr7 platform x <+> doc <+> pprExpr8 platform y
pprExpr7 platform e = pprExpr8 platform e
131 132 133 134 135 136

infixMachOp7 (MO_Add _)  = Just (char '+')
infixMachOp7 (MO_Sub _)  = Just (char '-')
infixMachOp7 _           = Nothing

-- %left '/' '*' '%'
137 138 139
pprExpr8 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
   = pprExpr8 platform x <+> doc <+> pprExpr9 platform y
pprExpr8 platform e = pprExpr9 platform e
140 141 142 143 144 145

infixMachOp8 (MO_U_Quot _) = Just (char '/')
infixMachOp8 (MO_Mul _)    = Just (char '*')
infixMachOp8 (MO_U_Rem _)  = Just (char '%')
infixMachOp8 _             = Nothing

146 147
pprExpr9 :: Platform -> CmmExpr -> SDoc
pprExpr9 platform e =
148
   case e of
149 150
        CmmLit    lit       -> pprLit1 platform lit
        CmmLoad   expr rep  -> ppr rep <> brackets (pprPlatform platform expr)
151 152 153
        CmmReg    reg       -> ppr reg
        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
154
	CmmMachOp mop args  -> genMachOp platform mop args
155

156 157
genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp platform mop args
158 159
   | Just doc <- infixMachOp mop = case args of
        -- dyadic
160
        [x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
161 162

        -- unary
163
        [x]   -> doc <> pprExpr9 platform x
164 165 166

        _     -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
                          (pprMachOp mop <+>
167
                            parens (hcat $ punctuate comma (map (pprExpr platform) args)))
168 169 170 171
                          empty

   | isJust (infixMachOp1 mop)
   || isJust (infixMachOp7 mop)
172
   || isJust (infixMachOp8 mop)	 = parens (pprExpr platform (CmmMachOp mop args))
173

174
   | otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
        where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
                                 (show mop))
                -- replace spaces in (show mop) with underscores,

--
-- Unsigned ops on the word size of the machine get nice symbols.
-- All else get dumped in their ugly format.
--
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp mop
	= case mop of
            MO_And    _ -> Just $ char '&'
            MO_Or     _ -> Just $ char '|'
            MO_Xor    _ -> Just $ char '^'
            MO_Not    _ -> Just $ char '~'
            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
            _ -> Nothing

-- --------------------------------------------------------------------------
-- Literals.
--  To minimise line noise we adopt the convention that if the literal
--  has the natural machine word size, we do not append the type
--
198 199
pprLit :: Platform -> CmmLit -> SDoc
pprLit platform lit = case lit of
200 201 202 203 204
    CmmInt i rep ->
        hcat [ (if i < 0 then parens else id)(integer i)
             , ppUnless (rep == wordWidth) $
               space <> dcolon <+> ppr rep ]

205
    CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
206 207 208 209
    CmmLabel clbl      -> pprCLabel platform clbl
    CmmLabelOff clbl i -> pprCLabel platform clbl <> ppr_offset i
    CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel platform clbl1 <> char '-'  
                                  <> pprCLabel platform clbl2 <> ppr_offset i
210 211 212
    CmmBlock id        -> ppr id
    CmmHighStackMark -> text "<highSp>"

213 214 215
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 platform lit@(CmmLabelOff {}) = parens (pprLit platform lit)
pprLit1 platform lit                  = pprLit platform lit
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286

ppr_offset :: Int -> SDoc
ppr_offset i
    | i==0      = empty
    | i>=0      = char '+' <> int i
    | otherwise = char '-' <> int (-i)

-- --------------------------------------------------------------------------
-- Registers, whether local (temps) or global
--
pprReg :: CmmReg -> SDoc
pprReg r 
    = case r of
        CmmLocal  local  -> pprLocalReg  local
        CmmGlobal global -> pprGlobalReg global

--
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg uniq rep) 
--   = ppr rep <> char '_' <> ppr uniq
-- Temp Jan08
   = char '_' <> ppr uniq <> 
       (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08		-- sigh
                    then dcolon <> ptr <> ppr rep
                    else dcolon <> ptr <> ppr rep)
   where
     ptr = empty
	 --if isGcPtrType rep
	 --      then doubleQuotes (text "ptr")
         --      else empty

-- Stack areas
pprArea :: Area -> SDoc
pprArea (RegSlot r)   = hcat [ text "slot<", ppr r, text ">" ]
pprArea (CallArea id) = pprAreaId id

pprAreaId :: AreaId -> SDoc
pprAreaId Old        = text "old"
pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]

-- needs to be kept in syn with CmmExpr.hs.GlobalReg
--
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg gr 
    = case gr of
        VanillaReg n _ -> char 'R' <> int n
-- Temp Jan08
--        VanillaReg n VNonGcPtr -> char 'R' <> int n
--        VanillaReg n VGcPtr    -> char 'P' <> int n
        FloatReg   n   -> char 'F' <> int n
        DoubleReg  n   -> char 'D' <> int n
        LongReg    n   -> char 'L' <> int n
        Sp             -> ptext (sLit "Sp")
        SpLim          -> ptext (sLit "SpLim")
        Hp             -> ptext (sLit "Hp")
        HpLim          -> ptext (sLit "HpLim")
        CurrentTSO     -> ptext (sLit "CurrentTSO")
        CurrentNursery -> ptext (sLit "CurrentNursery")
        HpAlloc        -> ptext (sLit "HpAlloc")
        EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
        GCEnter1       -> ptext (sLit "stg_gc_enter_1")
        GCFun          -> ptext (sLit "stg_gc_fun")
        BaseReg        -> ptext (sLit "BaseReg")
        PicBaseReg     -> ptext (sLit "PicBaseReg")

-----------------------------------------------------------------------------

commafy :: [SDoc] -> SDoc
commafy xs = fsep $ punctuate comma xs