{-# 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
_ = forall a. Outputable a => a -> SDoc
ppr
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 (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
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
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
"==")
infixMachOp1 (MO_Ne Width
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
"!=")
infixMachOp1 (MO_Shl Width
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
"<<")
infixMachOp1 (MO_U_Shr Width
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
">>")
infixMachOp1 (MO_U_Ge Width
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
">=")
infixMachOp1 (MO_U_Le Width
_) = forall a. a -> Maybe a
Just (String -> SDoc
text String
"<=")
infixMachOp1 (MO_U_Gt Width
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'>')
infixMachOp1 (MO_U_Lt Width
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'<')
infixMachOp1 MachOp
_ = forall a. Maybe a
Nothing
pprExpr7 :: Platform -> CmmExpr -> SDoc
pprExpr7 Platform
platform (CmmMachOp (MO_Add Width
rep1) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
rep2)]) | Integer
i 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 (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
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'+')
infixMachOp7 (MO_Sub Width
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'-')
infixMachOp7 MachOp
_ = forall a. Maybe a
Nothing
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
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'/')
infixMachOp8 (MO_Mul Width
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'*')
infixMachOp8 (MO_U_Rem Width
_) = forall a. a -> Maybe a
Just (Char -> SDoc
char Char
'%')
infixMachOp8 MachOp
_ = 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 forall a. Outputable a => a -> SDoc
ppr CmmType
rep SDoc -> SDoc -> SDoc
<> SDoc
align_mark SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
CmmReg CmmReg
reg -> forall a. Outputable a => a -> SDoc
ppr CmmReg
reg
CmmRegOff CmmReg
reg Int
off -> SDoc -> SDoc
parens (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 (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
[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
[CmmExpr
x] -> SDoc
doc SDoc -> SDoc -> SDoc
<> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
x
[CmmExpr]
_ -> 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 forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args)))
SDoc
empty
| forall a. Maybe a -> Bool
isJust (MachOp -> Maybe SDoc
infixMachOp1 MachOp
mop)
Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (MachOp -> Maybe SDoc
infixMachOp7 MachOp
mop)
Bool -> Bool -> 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 (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 (forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'_' else Char
c)
(forall a. Show a => a -> String
show MachOp
mop))
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp MachOp
mop
= case MachOp
mop of
MO_And Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'&'
MO_Or Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'|'
MO_Xor Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'^'
MO_Not Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'~'
MO_S_Neg Width
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'-'
MachOp
_ -> forall a. Maybe a
Nothing
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 forall a. Ord a => a -> a -> Bool
< Integer
0 then SDoc -> SDoc
parens else forall a. a -> a
id)(Integer -> SDoc
integer Integer
i)
, Bool -> SDoc -> SDoc
ppUnless (Width
rep forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform) forall a b. (a -> b) -> a -> b
$
SDoc
space SDoc -> SDoc -> SDoc
<> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Width
rep ]
CmmFloat Rational
f Width
rep -> [SDoc] -> SDoc
hsep [ Double -> SDoc
double (forall a. RealFloat a => Rational -> a
fromRat Rational
f), SDoc
dcolon, forall a. Outputable a => a -> SDoc
ppr Width
rep ]
CmmVec [CmmLit]
lits -> Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
commafy (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 -> forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl
CmmLabelOff CLabel
clbl Int
i -> 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
_ -> forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-'
SDoc -> SDoc -> 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 -> 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
iforall a. Eq a => a -> a -> Bool
==Int
0 = SDoc
empty
| Int
iforall 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)
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
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg Unique
uniq CmmType
rep) =
Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
pprUnique Unique
uniq SDoc -> SDoc -> SDoc
<>
(if CmmType -> Bool
isWord32 CmmType
rep
then SDoc
dcolon SDoc -> SDoc -> SDoc
<> SDoc
ptr SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr CmmType
rep
else SDoc
dcolon SDoc -> SDoc -> SDoc
<> SDoc
ptr SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr CmmType
rep)
where
pprUnique :: a -> SDoc
pprUnique a
unique = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressUniques forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> String -> SDoc
text String
"_locVar_"
Bool
False -> forall a. Outputable a => a -> SDoc
ppr a
unique
ptr :: SDoc
ptr = SDoc
empty
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<", forall a. Outputable a => a -> SDoc
ppr BlockId
id, String -> SDoc
text String
">" ]
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
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 forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
xs