----------------------------------------------------------------------------
--
-- 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.cs.tufts.edu/~nr/c--/index.html. 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
--
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module GHC.Cmm.Ppr.Expr
    ( pprExpr, pprLit
    )
where

import GHC.Prelude

import GHC.Driver.Ppr

import GHC.Platform
import GHC.Cmm.Expr

import GHC.Utils.Outputable

import Data.Maybe
import Numeric ( fromRat )

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

instance OutputableP Platform CmmExpr where
    pdoc :: Platform -> CmmExpr -> SDoc
pdoc = Platform -> CmmExpr -> SDoc
pprExpr

instance Outputable CmmReg where
    ppr :: CmmReg -> SDoc
ppr CmmReg
e = CmmReg -> SDoc
pprReg CmmReg
e

instance OutputableP Platform CmmLit where
    pdoc :: Platform -> CmmLit -> SDoc
pdoc = Platform -> CmmLit -> SDoc
pprLit

instance Outputable LocalReg where
    ppr :: LocalReg -> SDoc
ppr LocalReg
e = LocalReg -> SDoc
pprLocalReg LocalReg
e

instance Outputable Area where
    ppr :: Area -> SDoc
ppr Area
e = Area -> SDoc
pprArea Area
e

instance Outputable GlobalReg where
    ppr :: GlobalReg -> SDoc
ppr GlobalReg
e = GlobalReg -> SDoc
pprGlobalReg GlobalReg
e

instance OutputableP env GlobalReg where
    pdoc :: env -> GlobalReg -> SDoc
pdoc env
_ = GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr

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

pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
e
    = case CmmExpr
e of
        CmmRegOff CmmReg
reg Int
i ->
                Platform -> CmmExpr -> SDoc
pprExpr Platform
platform (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
rep)
                           [CmmReg -> CmmExpr
CmmReg CmmReg
reg, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Width
rep)])
                where rep :: Width
rep = CmmType -> Width
typeWidth (Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg)
        CmmLit CmmLit
lit -> Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit
        CmmExpr
_other     -> Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform CmmExpr
e

-- Here's the precedence table from GHC.Cmm.Parser:
-- %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 '>=' '>' '<=' '<' '!=' '=='
pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
pprExpr1 :: Platform -> CmmExpr -> SDoc
pprExpr1 Platform
platform (CmmMachOp MachOp
op [CmmExpr
x,CmmExpr
y])
   | Just SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp1 MachOp
op
   = Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform CmmExpr
y
pprExpr1 Platform
platform CmmExpr
e = Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform CmmExpr
e

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

infixMachOp1 :: MachOp -> Maybe SDoc
infixMachOp1 (MO_Eq     Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
"==")
infixMachOp1 (MO_Ne     Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
"!=")
infixMachOp1 (MO_Shl    Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
"<<")
infixMachOp1 (MO_U_Shr  Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
">>")
infixMachOp1 (MO_U_Ge   Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
">=")
infixMachOp1 (MO_U_Le   Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text String
"<=")
infixMachOp1 (MO_U_Gt   Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'>')
infixMachOp1 (MO_U_Lt   Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'<')
infixMachOp1 MachOp
_             = Maybe SDoc
forall a. Maybe a
Nothing

-- %left '-' '+'
pprExpr7 :: Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform (CmmMachOp (MO_Add Width
rep1) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
rep2)]) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
   = Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Sub Width
rep1) [CmmExpr
x, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i) Width
rep2)])
pprExpr7 Platform
platform (CmmMachOp MachOp
op [CmmExpr
x,CmmExpr
y])
   | Just SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp7 MachOp
op
   = Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
pprExpr8 Platform
platform CmmExpr
y
pprExpr7 Platform
platform CmmExpr
e = Platform -> CmmExpr -> SDoc
pprExpr8 Platform
platform CmmExpr
e

infixMachOp7 :: MachOp -> Maybe SDoc
infixMachOp7 (MO_Add Width
_)  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'+')
infixMachOp7 (MO_Sub Width
_)  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'-')
infixMachOp7 MachOp
_           = Maybe SDoc
forall a. Maybe a
Nothing

-- %left '/' '*' '%'
pprExpr8 :: Platform -> CmmExpr -> SDoc
pprExpr8 Platform
platform (CmmMachOp MachOp
op [CmmExpr
x,CmmExpr
y])
   | Just SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp8 MachOp
op
   = Platform -> CmmExpr -> SDoc
pprExpr8 Platform
platform CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
y
pprExpr8 Platform
platform CmmExpr
e = Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
e

infixMachOp8 :: MachOp -> Maybe SDoc
infixMachOp8 (MO_U_Quot Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'/')
infixMachOp8 (MO_Mul Width
_)    = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'*')
infixMachOp8 (MO_U_Rem Width
_)  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'%')
infixMachOp8 MachOp
_             = Maybe SDoc
forall a. Maybe a
Nothing

pprExpr9 :: Platform -> CmmExpr -> SDoc
pprExpr9 :: Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
e =
   case CmmExpr
e of
        CmmLit    CmmLit
lit       -> Platform -> CmmLit -> SDoc
pprLit1 Platform
platform CmmLit
lit
        CmmLoad   CmmExpr
expr CmmType
rep AlignmentSpec
align
                            -> let align_mark :: SDoc
align_mark =
                                       case AlignmentSpec
align of
                                         AlignmentSpec
NaturallyAligned -> SDoc
empty
                                         AlignmentSpec
Unaligned        -> String -> SDoc
text String
"^"
                                in CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep SDoc -> SDoc -> SDoc
<> SDoc
align_mark SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
        CmmReg    CmmReg
reg       -> CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg
        CmmRegOff  CmmReg
reg Int
off  -> SDoc -> SDoc
parens (CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
off)
        CmmStackSlot Area
a Int
off  -> SDoc -> SDoc
parens (Area -> SDoc
forall a. Outputable a => a -> SDoc
ppr Area
a   SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
off)
        CmmMachOp MachOp
mop [CmmExpr]
args  -> Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp Platform
platform MachOp
mop [CmmExpr]
args

genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp Platform
platform MachOp
mop [CmmExpr]
args
   | Just SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp MachOp
mop = case [CmmExpr]
args of
        -- dyadic
        [CmmExpr
x,CmmExpr
y] -> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
y

        -- unary
        [CmmExpr
x]   -> SDoc
doc SDoc -> SDoc -> SDoc
<> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
x

        [CmmExpr]
_     -> String -> SDoc -> SDoc -> SDoc
forall a. String -> SDoc -> a -> a
pprTrace String
"GHC.Cmm.Ppr.Expr.genMachOp: machop with strange number of args"
                          (MachOp -> SDoc
pprMachOp MachOp
mop SDoc -> SDoc -> SDoc
<+>
                            SDoc -> SDoc
parens ([SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args)))
                          SDoc
empty

   | Maybe SDoc -> Bool
forall a. Maybe a -> Bool
isJust (MachOp -> Maybe SDoc
infixMachOp1 MachOp
mop)
   Bool -> Bool -> Bool
|| Maybe SDoc -> Bool
forall a. Maybe a -> Bool
isJust (MachOp -> Maybe SDoc
infixMachOp7 MachOp
mop)
   Bool -> Bool -> Bool
|| Maybe SDoc -> Bool
forall a. Maybe a -> Bool
isJust (MachOp -> Maybe SDoc
infixMachOp8 MachOp
mop)  = SDoc -> SDoc
parens (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr]
args))

   | Bool
otherwise = Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> SDoc
ppr_op SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens ([SDoc] -> SDoc
commafy ((CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args))
        where ppr_op :: SDoc
ppr_op = String -> SDoc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'_' else Char
c)
                                 (MachOp -> String
forall a. Show a => a -> String
show MachOp
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 :: MachOp -> Maybe SDoc
infixMachOp MachOp
mop
        = case MachOp
mop of
            MO_And    Width
_ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'&'
            MO_Or     Width
_ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'|'
            MO_Xor    Width
_ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'^'
            MO_Not    Width
_ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'~'
            MO_S_Neg  Width
_ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'-' -- there is no unsigned neg :)
            MachOp
_ -> Maybe SDoc
forall a. Maybe a
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
--
pprLit :: Platform -> CmmLit -> SDoc
pprLit :: Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit = case CmmLit
lit of
    CmmInt Integer
i Width
rep ->
        [SDoc] -> SDoc
hcat [ (if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then SDoc -> SDoc
parens else SDoc -> SDoc
forall a. a -> a
id)(Integer -> SDoc
integer Integer
i)
             , Bool -> SDoc -> SDoc
ppUnless (Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
               SDoc
space SDoc -> SDoc -> SDoc
<> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
rep ]

    CmmFloat Rational
f Width
rep     -> [SDoc] -> SDoc
hsep [ Double -> SDoc
double (Rational -> Double
forall a. RealFloat a => Rational -> a
fromRat Rational
f), SDoc
dcolon, Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
rep ]
    CmmVec [CmmLit]
lits        -> Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
commafy ((CmmLit -> SDoc) -> [CmmLit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmLit -> SDoc
pprLit Platform
platform) [CmmLit]
lits) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'>'
    CmmLabel CLabel
clbl      -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl
    CmmLabelOff CLabel
clbl Int
i -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl SDoc -> SDoc -> SDoc
<> Int -> SDoc
ppr_offset Int
i
    CmmLabelDiffOff CLabel
clbl1 CLabel
clbl2 Int
i Width
_ -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-'
                                       SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl2 SDoc -> SDoc -> SDoc
<> Int -> SDoc
ppr_offset Int
i
    CmmBlock BlockId
id        -> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id
    CmmLit
CmmHighStackMark -> String -> SDoc
text String
"<highSp>"

pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 Platform
platform lit :: CmmLit
lit@(CmmLabelOff {}) = SDoc -> SDoc
parens (Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit)
pprLit1 Platform
platform CmmLit
lit                  = Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit

ppr_offset :: Int -> SDoc
ppr_offset :: Int -> SDoc
ppr_offset Int
i
    | Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0      = SDoc
empty
    | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0      = Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
    | Bool
otherwise = Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (-Int
i)

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

--
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg Unique
uniq CmmType
rep) =
--   = ppr rep <> char '_' <> ppr uniq
-- Temp Jan08
    Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> Unique -> SDoc
forall a. Outputable a => a -> SDoc
pprUnique Unique
uniq SDoc -> SDoc -> SDoc
<>
       (if CmmType -> Bool
isWord32 CmmType
rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
                    then SDoc
dcolon SDoc -> SDoc -> SDoc
<> SDoc
ptr SDoc -> SDoc -> SDoc
<> CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep
                    else SDoc
dcolon SDoc -> SDoc -> SDoc
<> SDoc
ptr SDoc -> SDoc -> SDoc
<> CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep)
   where
     pprUnique :: a -> SDoc
pprUnique a
unique = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressUniques ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
       Bool
True  -> String -> SDoc
text String
"_locVar_"
       Bool
False -> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
unique
     ptr :: SDoc
ptr = SDoc
empty
         --if isGcPtrType rep
         --      then doubleQuotes (text "ptr")
         --      else empty

-- Stack areas
pprArea :: Area -> SDoc
pprArea :: Area -> SDoc
pprArea Area
Old        = String -> SDoc
text String
"old"
pprArea (Young BlockId
id) = [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"young<", BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id, String -> SDoc
text String
">" ]

-- needs to be kept in syn with 'GHC.Cmm.Expr.GlobalReg'
--
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg GlobalReg
gr
    = case GlobalReg
gr of
        VanillaReg Int
n VGcPtr
_ -> Char -> SDoc
char Char
'R' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
-- Temp Jan08
--        VanillaReg n VNonGcPtr -> char 'R' <> int n
--        VanillaReg n VGcPtr    -> char 'P' <> int n
        FloatReg   Int
n   -> Char -> SDoc
char Char
'F' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        DoubleReg  Int
n   -> Char -> SDoc
char Char
'D' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        LongReg    Int
n   -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        XmmReg     Int
n   -> String -> SDoc
text String
"XMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        YmmReg     Int
n   -> String -> SDoc
text String
"YMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        ZmmReg     Int
n   -> String -> SDoc
text String
"ZMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
        GlobalReg
Sp             -> String -> SDoc
text String
"Sp"
        GlobalReg
SpLim          -> String -> SDoc
text String
"SpLim"
        GlobalReg
Hp             -> String -> SDoc
text String
"Hp"
        GlobalReg
HpLim          -> String -> SDoc
text String
"HpLim"
        GlobalReg
MachSp         -> String -> SDoc
text String
"MachSp"
        GlobalReg
UnwindReturnReg-> String -> SDoc
text String
"UnwindReturnReg"
        GlobalReg
CCCS           -> String -> SDoc
text String
"CCCS"
        GlobalReg
CurrentTSO     -> String -> SDoc
text String
"CurrentTSO"
        GlobalReg
CurrentNursery -> String -> SDoc
text String
"CurrentNursery"
        GlobalReg
HpAlloc        -> String -> SDoc
text String
"HpAlloc"
        GlobalReg
EagerBlackholeInfo -> String -> SDoc
text String
"stg_EAGER_BLACKHOLE_info"
        GlobalReg
GCEnter1       -> String -> SDoc
text String
"stg_gc_enter_1"
        GlobalReg
GCFun          -> String -> SDoc
text String
"stg_gc_fun"
        GlobalReg
BaseReg        -> String -> SDoc
text String
"BaseReg"
        GlobalReg
PicBaseReg     -> String -> SDoc
text String
"PicBaseReg"

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

commafy :: [SDoc] -> SDoc
commafy :: [SDoc] -> SDoc
commafy [SDoc]
xs = [SDoc] -> SDoc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
xs