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