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