{-# OPTIONS_GHC -fno-warn-orphans #-}
module PprCmmExpr
( pprExpr, pprLit
)
where
import GhcPrelude
import CmmExpr
import Outputable
import DynFlags
import Data.Maybe
import Numeric ( fromRat )
instance Outputable CmmExpr where
ppr :: CmmExpr -> SDoc
ppr e :: CmmExpr
e = CmmExpr -> SDoc
pprExpr CmmExpr
e
instance Outputable CmmReg where
ppr :: CmmReg -> SDoc
ppr e :: CmmReg
e = CmmReg -> SDoc
pprReg CmmReg
e
instance Outputable CmmLit where
ppr :: CmmLit -> SDoc
ppr l :: CmmLit
l = CmmLit -> SDoc
pprLit CmmLit
l
instance Outputable LocalReg where
ppr :: LocalReg -> SDoc
ppr e :: LocalReg
e = LocalReg -> SDoc
pprLocalReg LocalReg
e
instance Outputable Area where
ppr :: Area -> SDoc
ppr e :: Area
e = Area -> SDoc
pprArea Area
e
instance Outputable GlobalReg where
ppr :: GlobalReg -> SDoc
ppr e :: GlobalReg
e = GlobalReg -> SDoc
pprGlobalReg GlobalReg
e
pprExpr :: CmmExpr -> SDoc
pprExpr :: CmmExpr -> SDoc
pprExpr e :: CmmExpr
e
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
case CmmExpr
e of
CmmRegOff reg :: CmmReg
reg i :: Int
i ->
CmmExpr -> SDoc
pprExpr (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 (DynFlags -> CmmReg -> CmmType
cmmRegType DynFlags
dflags CmmReg
reg)
CmmLit lit :: CmmLit
lit -> CmmLit -> SDoc
pprLit CmmLit
lit
_other :: CmmExpr
_other -> CmmExpr -> SDoc
pprExpr1 CmmExpr
e
pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
pprExpr1 :: CmmExpr -> SDoc
pprExpr1 (CmmMachOp op :: MachOp
op [x :: CmmExpr
x,y :: CmmExpr
y]) | Just doc :: SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp1 MachOp
op
= CmmExpr -> SDoc
pprExpr7 CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
pprExpr7 CmmExpr
y
pprExpr1 e :: CmmExpr
e = CmmExpr -> SDoc
pprExpr7 CmmExpr
e
infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
infixMachOp1 :: MachOp -> Maybe SDoc
infixMachOp1 (MO_Eq _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text "==")
infixMachOp1 (MO_Ne _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text "!=")
infixMachOp1 (MO_Shl _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text "<<")
infixMachOp1 (MO_U_Shr _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text ">>")
infixMachOp1 (MO_U_Ge _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text ">=")
infixMachOp1 (MO_U_Le _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
text "<=")
infixMachOp1 (MO_U_Gt _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '>')
infixMachOp1 (MO_U_Lt _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '<')
infixMachOp1 _ = Maybe SDoc
forall a. Maybe a
Nothing
pprExpr7 :: CmmExpr -> SDoc
pprExpr7 (CmmMachOp (MO_Add rep1 :: Width
rep1) [x :: CmmExpr
x, CmmLit (CmmInt i :: Integer
i rep2 :: Width
rep2)]) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
= CmmExpr -> SDoc
pprExpr7 (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 (CmmMachOp op :: MachOp
op [x :: CmmExpr
x,y :: CmmExpr
y]) | Just doc :: SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp7 MachOp
op
= CmmExpr -> SDoc
pprExpr7 CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
pprExpr8 CmmExpr
y
pprExpr7 e :: CmmExpr
e = CmmExpr -> SDoc
pprExpr8 CmmExpr
e
infixMachOp7 :: MachOp -> Maybe SDoc
infixMachOp7 (MO_Add _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '+')
infixMachOp7 (MO_Sub _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '-')
infixMachOp7 _ = Maybe SDoc
forall a. Maybe a
Nothing
pprExpr8 :: CmmExpr -> SDoc
pprExpr8 (CmmMachOp op :: MachOp
op [x :: CmmExpr
x,y :: CmmExpr
y]) | Just doc :: SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp8 MachOp
op
= CmmExpr -> SDoc
pprExpr8 CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
pprExpr9 CmmExpr
y
pprExpr8 e :: CmmExpr
e = CmmExpr -> SDoc
pprExpr9 CmmExpr
e
infixMachOp8 :: MachOp -> Maybe SDoc
infixMachOp8 (MO_U_Quot _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '/')
infixMachOp8 (MO_Mul _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '*')
infixMachOp8 (MO_U_Rem _) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
char '%')
infixMachOp8 _ = Maybe SDoc
forall a. Maybe a
Nothing
pprExpr9 :: CmmExpr -> SDoc
pprExpr9 :: CmmExpr -> SDoc
pprExpr9 e :: CmmExpr
e =
case CmmExpr
e of
CmmLit lit :: CmmLit
lit -> CmmLit -> SDoc
pprLit1 CmmLit
lit
CmmLoad expr :: CmmExpr
expr rep :: CmmType
rep -> CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr)
CmmReg reg :: CmmReg
reg -> CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg
CmmRegOff reg :: CmmReg
reg off :: Int
off -> SDoc -> SDoc
parens (CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
off)
CmmStackSlot a :: Area
a off :: Int
off -> SDoc -> SDoc
parens (Area -> SDoc
forall a. Outputable a => a -> SDoc
ppr Area
a SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
off)
CmmMachOp mop :: MachOp
mop args :: [CmmExpr]
args -> MachOp -> [CmmExpr] -> SDoc
genMachOp MachOp
mop [CmmExpr]
args
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp mop :: MachOp
mop args :: [CmmExpr]
args
| Just doc :: SDoc
doc <- MachOp -> Maybe SDoc
infixMachOp MachOp
mop = case [CmmExpr]
args of
[x :: CmmExpr
x,y :: CmmExpr
y] -> CmmExpr -> SDoc
pprExpr9 CmmExpr
x SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
pprExpr9 CmmExpr
y
[x :: CmmExpr
x] -> SDoc
doc SDoc -> SDoc -> SDoc
<> CmmExpr -> SDoc
pprExpr9 CmmExpr
x
_ -> String -> SDoc -> SDoc -> SDoc
forall a. String -> SDoc -> a -> a
pprTrace "PprCmm.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 CmmExpr -> SDoc
pprExpr [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 (CmmExpr -> SDoc
pprExpr (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr]
args))
| Bool
otherwise = Char -> SDoc
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 CmmExpr -> SDoc
pprExpr [CmmExpr]
args))
where ppr_op :: SDoc
ppr_op = String -> SDoc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' then '_' else Char
c)
(MachOp -> String
forall a. Show a => a -> String
show MachOp
mop))
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp mop :: MachOp
mop
= case MachOp
mop of
MO_And _ -> 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 '&'
MO_Or _ -> 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 '|'
MO_Xor _ -> 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 '^'
MO_Not _ -> 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 '~'
MO_S_Neg _ -> 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 '-'
_ -> Maybe SDoc
forall a. Maybe a
Nothing
pprLit :: CmmLit -> SDoc
pprLit :: CmmLit -> SDoc
pprLit lit :: CmmLit
lit = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
case CmmLit
lit of
CmmInt i :: Integer
i rep :: Width
rep ->
[SDoc] -> SDoc
hcat [ (if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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
== DynFlags -> Width
wordWidth DynFlags
dflags) (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 f :: Rational
f rep :: 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 lits :: [CmmLit]
lits -> Char -> SDoc
char '<' SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
commafy ((CmmLit -> SDoc) -> [CmmLit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmLit -> SDoc
pprLit [CmmLit]
lits) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '>'
CmmLabel clbl :: CLabel
clbl -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
clbl
CmmLabelOff clbl :: CLabel
clbl i :: Int
i -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
clbl SDoc -> SDoc -> SDoc
<> Int -> SDoc
ppr_offset Int
i
CmmLabelDiffOff clbl1 :: CLabel
clbl1 clbl2 :: CLabel
clbl2 i :: Int
i _ -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
clbl1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '-'
SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
clbl2 SDoc -> SDoc -> SDoc
<> Int -> SDoc
ppr_offset Int
i
CmmBlock id :: BlockId
id -> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id
CmmHighStackMark -> String -> SDoc
text "<highSp>"
pprLit1 :: CmmLit -> SDoc
pprLit1 :: CmmLit -> SDoc
pprLit1 lit :: CmmLit
lit@(CmmLabelOff {}) = SDoc -> SDoc
parens (CmmLit -> SDoc
pprLit CmmLit
lit)
pprLit1 lit :: CmmLit
lit = CmmLit -> SDoc
pprLit CmmLit
lit
ppr_offset :: Int -> SDoc
ppr_offset :: Int -> SDoc
ppr_offset i :: Int
i
| Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0 = SDoc
empty
| Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=0 = Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
| Bool
otherwise = Char -> SDoc
char '-' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (-Int
i)
pprReg :: CmmReg -> SDoc
pprReg :: CmmReg -> SDoc
pprReg r :: CmmReg
r
= case CmmReg
r of
CmmLocal local :: LocalReg
local -> LocalReg -> SDoc
pprLocalReg LocalReg
local
CmmGlobal global :: GlobalReg
global -> GlobalReg -> SDoc
pprGlobalReg GlobalReg
global
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg uniq :: Unique
uniq rep :: CmmType
rep) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
Char -> SDoc
char '_' SDoc -> SDoc -> SDoc
<> DynFlags -> Unique -> SDoc
forall a. Outputable a => DynFlags -> a -> SDoc
pprUnique DynFlags
dflags Unique
uniq SDoc -> SDoc -> SDoc
<>
(if CmmType -> Bool
isWord32 CmmType
rep
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 :: DynFlags -> a -> SDoc
pprUnique dflags :: DynFlags
dflags unique :: a
unique =
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags
then String -> SDoc
text "_locVar_"
else a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
unique
ptr :: SDoc
ptr = SDoc
empty
pprArea :: Area -> SDoc
pprArea :: Area -> SDoc
pprArea Old = String -> SDoc
text "old"
pprArea (Young id :: BlockId
id) = [SDoc] -> SDoc
hcat [ String -> SDoc
text "young<", BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id, String -> SDoc
text ">" ]
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg gr :: GlobalReg
gr
= case GlobalReg
gr of
VanillaReg n :: Int
n _ -> Char -> SDoc
char 'R' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
FloatReg n :: Int
n -> Char -> SDoc
char 'F' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
DoubleReg n :: Int
n -> Char -> SDoc
char 'D' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
LongReg n :: Int
n -> Char -> SDoc
char 'L' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
XmmReg n :: Int
n -> String -> SDoc
text "XMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
YmmReg n :: Int
n -> String -> SDoc
text "YMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
ZmmReg n :: Int
n -> String -> SDoc
text "ZMM" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n
Sp -> String -> SDoc
text "Sp"
SpLim -> String -> SDoc
text "SpLim"
Hp -> String -> SDoc
text "Hp"
HpLim -> String -> SDoc
text "HpLim"
MachSp -> String -> SDoc
text "MachSp"
UnwindReturnReg-> String -> SDoc
text "UnwindReturnReg"
CCCS -> String -> SDoc
text "CCCS"
CurrentTSO -> String -> SDoc
text "CurrentTSO"
CurrentNursery -> String -> SDoc
text "CurrentNursery"
HpAlloc -> String -> SDoc
text "HpAlloc"
EagerBlackholeInfo -> String -> SDoc
text "stg_EAGER_BLACKHOLE_info"
GCEnter1 -> String -> SDoc
text "stg_gc_enter_1"
GCFun -> String -> SDoc
text "stg_gc_fun"
BaseReg -> String -> SDoc
text "BaseReg"
PicBaseReg -> String -> SDoc
text "PicBaseReg"
commafy :: [SDoc] -> SDoc
commafy :: [SDoc] -> SDoc
commafy xs :: [SDoc]
xs = [SDoc] -> SDoc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
xs