{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Cmm.Expr
( CmmExpr(..), cmmExprType, cmmExprWidth, cmmExprAlignment, maybeInvertCmmExpr
, CmmReg(..), cmmRegType, cmmRegWidth
, CmmLit(..), cmmLitType
, AlignmentSpec(..)
, LocalReg(..), localRegType
, GlobalReg(..), isArgReg, globalRegType
, spReg, hpReg, spLimReg, hpLimReg, nodeReg
, currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
, node, baseReg
, VGcPtr(..)
, DefinerOfRegs, UserOfRegs
, foldRegsDefd, foldRegsUsed
, foldLocalRegsDefd, foldLocalRegsUsed
, RegSet, LocalRegSet, GlobalRegSet
, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
, plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
, regSetToList
, isTrivialCmmExpr
, hasNoGlobalRegs
, isLit
, isComparisonExpr
, Area(..)
, module GHC.Cmm.MachOp
, module GHC.Cmm.Type
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.MachOp
import GHC.Cmm.Type
import GHC.Cmm.Reg
import GHC.Utils.Panic (panic)
import GHC.Utils.Outputable
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Numeric ( fromRat )
import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)
data CmmExpr
= CmmLit !CmmLit
| CmmLoad !CmmExpr !CmmType !AlignmentSpec
| CmmReg !CmmReg
| CmmMachOp MachOp [CmmExpr]
| CmmStackSlot Area {-# UNPACK #-} !Int
| CmmRegOff !CmmReg !Int
deriving Int -> CmmExpr -> ShowS
[CmmExpr] -> ShowS
CmmExpr -> String
(Int -> CmmExpr -> ShowS)
-> (CmmExpr -> String) -> ([CmmExpr] -> ShowS) -> Show CmmExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmExpr -> ShowS
showsPrec :: Int -> CmmExpr -> ShowS
$cshow :: CmmExpr -> String
show :: CmmExpr -> String
$cshowList :: [CmmExpr] -> ShowS
showList :: [CmmExpr] -> ShowS
Show
instance Eq CmmExpr where
CmmLit CmmLit
l1 == :: CmmExpr -> CmmExpr -> Bool
== CmmLit CmmLit
l2 = CmmLit
l1CmmLit -> CmmLit -> Bool
forall a. Eq a => a -> a -> Bool
==CmmLit
l2
CmmLoad CmmExpr
e1 CmmType
_ AlignmentSpec
_ == CmmLoad CmmExpr
e2 CmmType
_ AlignmentSpec
_ = CmmExpr
e1CmmExpr -> CmmExpr -> Bool
forall a. Eq a => a -> a -> Bool
==CmmExpr
e2
CmmReg CmmReg
r1 == CmmReg CmmReg
r2 = CmmReg
r1CmmReg -> CmmReg -> Bool
forall a. Eq a => a -> a -> Bool
==CmmReg
r2
CmmRegOff CmmReg
r1 Int
i1 == CmmRegOff CmmReg
r2 Int
i2 = CmmReg
r1CmmReg -> CmmReg -> Bool
forall a. Eq a => a -> a -> Bool
==CmmReg
r2 Bool -> Bool -> Bool
&& Int
i1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i2
CmmMachOp MachOp
op1 [CmmExpr]
es1 == CmmMachOp MachOp
op2 [CmmExpr]
es2 = MachOp
op1MachOp -> MachOp -> Bool
forall a. Eq a => a -> a -> Bool
==MachOp
op2 Bool -> Bool -> Bool
&& [CmmExpr]
es1[CmmExpr] -> [CmmExpr] -> Bool
forall a. Eq a => a -> a -> Bool
==[CmmExpr]
es2
CmmStackSlot Area
a1 Int
i1 == CmmStackSlot Area
a2 Int
i2 = Area
a1Area -> Area -> Bool
forall a. Eq a => a -> a -> Bool
==Area
a2 Bool -> Bool -> Bool
&& Int
i1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i2
CmmExpr
_e1 == CmmExpr
_e2 = Bool
False
instance OutputableP Platform CmmExpr where
pdoc :: Platform -> CmmExpr -> SDoc
pdoc = Platform -> CmmExpr -> SDoc
pprExpr
data AlignmentSpec = NaturallyAligned | Unaligned
deriving (AlignmentSpec -> AlignmentSpec -> Bool
(AlignmentSpec -> AlignmentSpec -> Bool)
-> (AlignmentSpec -> AlignmentSpec -> Bool) -> Eq AlignmentSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlignmentSpec -> AlignmentSpec -> Bool
== :: AlignmentSpec -> AlignmentSpec -> Bool
$c/= :: AlignmentSpec -> AlignmentSpec -> Bool
/= :: AlignmentSpec -> AlignmentSpec -> Bool
Eq, Eq AlignmentSpec
Eq AlignmentSpec =>
(AlignmentSpec -> AlignmentSpec -> Ordering)
-> (AlignmentSpec -> AlignmentSpec -> Bool)
-> (AlignmentSpec -> AlignmentSpec -> Bool)
-> (AlignmentSpec -> AlignmentSpec -> Bool)
-> (AlignmentSpec -> AlignmentSpec -> Bool)
-> (AlignmentSpec -> AlignmentSpec -> AlignmentSpec)
-> (AlignmentSpec -> AlignmentSpec -> AlignmentSpec)
-> Ord AlignmentSpec
AlignmentSpec -> AlignmentSpec -> Bool
AlignmentSpec -> AlignmentSpec -> Ordering
AlignmentSpec -> AlignmentSpec -> AlignmentSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AlignmentSpec -> AlignmentSpec -> Ordering
compare :: AlignmentSpec -> AlignmentSpec -> Ordering
$c< :: AlignmentSpec -> AlignmentSpec -> Bool
< :: AlignmentSpec -> AlignmentSpec -> Bool
$c<= :: AlignmentSpec -> AlignmentSpec -> Bool
<= :: AlignmentSpec -> AlignmentSpec -> Bool
$c> :: AlignmentSpec -> AlignmentSpec -> Bool
> :: AlignmentSpec -> AlignmentSpec -> Bool
$c>= :: AlignmentSpec -> AlignmentSpec -> Bool
>= :: AlignmentSpec -> AlignmentSpec -> Bool
$cmax :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
max :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
$cmin :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
min :: AlignmentSpec -> AlignmentSpec -> AlignmentSpec
Ord, Int -> AlignmentSpec -> ShowS
[AlignmentSpec] -> ShowS
AlignmentSpec -> String
(Int -> AlignmentSpec -> ShowS)
-> (AlignmentSpec -> String)
-> ([AlignmentSpec] -> ShowS)
-> Show AlignmentSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlignmentSpec -> ShowS
showsPrec :: Int -> AlignmentSpec -> ShowS
$cshow :: AlignmentSpec -> String
show :: AlignmentSpec -> String
$cshowList :: [AlignmentSpec] -> ShowS
showList :: [AlignmentSpec] -> ShowS
Show)
data Area
= Old
| Young {-# UNPACK #-} !BlockId
deriving (Area -> Area -> Bool
(Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Area -> Area -> Bool
== :: Area -> Area -> Bool
$c/= :: Area -> Area -> Bool
/= :: Area -> Area -> Bool
Eq, Eq Area
Eq Area =>
(Area -> Area -> Ordering)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Area)
-> (Area -> Area -> Area)
-> Ord Area
Area -> Area -> Bool
Area -> Area -> Ordering
Area -> Area -> Area
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Area -> Area -> Ordering
compare :: Area -> Area -> Ordering
$c< :: Area -> Area -> Bool
< :: Area -> Area -> Bool
$c<= :: Area -> Area -> Bool
<= :: Area -> Area -> Bool
$c> :: Area -> Area -> Bool
> :: Area -> Area -> Bool
$c>= :: Area -> Area -> Bool
>= :: Area -> Area -> Bool
$cmax :: Area -> Area -> Area
max :: Area -> Area -> Area
$cmin :: Area -> Area -> Area
min :: Area -> Area -> Area
Ord, Int -> Area -> ShowS
[Area] -> ShowS
Area -> String
(Int -> Area -> ShowS)
-> (Area -> String) -> ([Area] -> ShowS) -> Show Area
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Area -> ShowS
showsPrec :: Int -> Area -> ShowS
$cshow :: Area -> String
show :: Area -> String
$cshowList :: [Area] -> ShowS
showList :: [Area] -> ShowS
Show)
instance Outputable Area where
ppr :: Area -> SDoc
ppr Area
e = Area -> SDoc
pprArea Area
e
pprArea :: Area -> SDoc
pprArea :: Area -> SDoc
pprArea Area
Old = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"old"
pprArea (Young BlockId
id) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"young<", BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">" ]
data CmmLit
= CmmInt !Integer !Width
| CmmFloat Rational !Width
| CmmVec [CmmLit]
| CmmLabel CLabel
| CmmLabelOff CLabel !Int
| CmmLabelDiffOff CLabel CLabel !Int !Width
| CmmBlock {-# UNPACK #-} !BlockId
| CmmHighStackMark
deriving (CmmLit -> CmmLit -> Bool
(CmmLit -> CmmLit -> Bool)
-> (CmmLit -> CmmLit -> Bool) -> Eq CmmLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmLit -> CmmLit -> Bool
== :: CmmLit -> CmmLit -> Bool
$c/= :: CmmLit -> CmmLit -> Bool
/= :: CmmLit -> CmmLit -> Bool
Eq, Int -> CmmLit -> ShowS
[CmmLit] -> ShowS
CmmLit -> String
(Int -> CmmLit -> ShowS)
-> (CmmLit -> String) -> ([CmmLit] -> ShowS) -> Show CmmLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmLit -> ShowS
showsPrec :: Int -> CmmLit -> ShowS
$cshow :: CmmLit -> String
show :: CmmLit -> String
$cshowList :: [CmmLit] -> ShowS
showList :: [CmmLit] -> ShowS
Show)
instance OutputableP Platform CmmLit where
pdoc :: Platform -> CmmLit -> SDoc
pdoc = Platform -> CmmLit -> SDoc
pprLit
instance Outputable CmmLit where
ppr :: CmmLit -> SDoc
ppr (CmmInt Integer
n Width
w) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmInt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Integer -> SDoc
forall a. Outputable a => a -> SDoc
ppr Integer
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w
ppr (CmmFloat Rational
n Width
w) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmFloat" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Rational -> String
forall a. Show a => a -> String
show Rational
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w
ppr (CmmVec [CmmLit]
xs) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmVec" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [CmmLit] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmLit]
xs
ppr (CmmLabel CLabel
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmLabel"
ppr (CmmLabelOff CLabel
_ Int
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmLabelOff"
ppr (CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmLabelDiffOff"
ppr (CmmBlock BlockId
blk) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmBlock" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
blk
ppr CmmLit
CmmHighStackMark = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmHighStackMark"
cmmExprType :: Platform -> CmmExpr -> CmmType
cmmExprType :: Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform = \case
(CmmLit CmmLit
lit) -> Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit
(CmmLoad CmmExpr
_ CmmType
rep AlignmentSpec
_) -> CmmType
rep
(CmmReg CmmReg
reg) -> Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg
(CmmMachOp MachOp
op [CmmExpr]
args) -> Platform -> MachOp -> [CmmType] -> CmmType
machOpResultType Platform
platform MachOp
op ((CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
args)
(CmmRegOff CmmReg
reg Int
_) -> Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg
(CmmStackSlot Area
_ Int
_) -> Platform -> CmmType
bWord Platform
platform
cmmLitType :: Platform -> CmmLit -> CmmType
cmmLitType :: Platform -> CmmLit -> CmmType
cmmLitType Platform
platform = \case
(CmmInt Integer
_ Width
width) -> Width -> CmmType
cmmBits Width
width
(CmmFloat Rational
_ Width
width) -> Width -> CmmType
cmmFloat Width
width
(CmmVec []) -> String -> CmmType
forall a. HasCallStack => String -> a
panic String
"cmmLitType: CmmVec []"
(CmmVec (CmmLit
l:[CmmLit]
ls)) -> let ty :: CmmType
ty = Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
l
in if (CmmType -> Bool) -> [CmmType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (CmmType -> CmmType -> Bool
`cmmEqType` CmmType
ty) ((CmmLit -> CmmType) -> [CmmLit] -> [CmmType]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform) [CmmLit]
ls)
then Int -> CmmType -> CmmType
cmmVec (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+[CmmLit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CmmLit]
ls) CmmType
ty
else String -> CmmType
forall a. HasCallStack => String -> a
panic String
"cmmLitType: CmmVec"
(CmmLabel CLabel
lbl) -> Platform -> CLabel -> CmmType
cmmLabelType Platform
platform CLabel
lbl
(CmmLabelOff CLabel
lbl Int
_) -> Platform -> CLabel -> CmmType
cmmLabelType Platform
platform CLabel
lbl
(CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
width) -> Width -> CmmType
cmmBits Width
width
(CmmBlock BlockId
_) -> Platform -> CmmType
bWord Platform
platform
(CmmLit
CmmHighStackMark) -> Platform -> CmmType
bWord Platform
platform
cmmLabelType :: Platform -> CLabel -> CmmType
cmmLabelType :: Platform -> CLabel -> CmmType
cmmLabelType Platform
platform CLabel
lbl
| CLabel -> Bool
isGcPtrLabel CLabel
lbl = Platform -> CmmType
gcWord Platform
platform
| Bool
otherwise = Platform -> CmmType
bWord Platform
platform
cmmExprWidth :: Platform -> CmmExpr -> Width
cmmExprWidth :: Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
e = CmmType -> Width
typeWidth (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
e)
cmmExprAlignment :: CmmExpr -> Alignment
cmmExprAlignment :: CmmExpr -> Alignment
cmmExprAlignment (CmmLit (CmmInt Integer
intOff Width
_)) = Int -> Alignment
alignmentOf (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
intOff)
cmmExprAlignment CmmExpr
_ = Int -> Alignment
mkAlignment Int
1
maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr (CmmMachOp MachOp
op [CmmExpr]
args) = do MachOp
op' <- MachOp -> Maybe MachOp
maybeInvertComparison MachOp
op
CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
op' [CmmExpr]
args)
maybeInvertCmmExpr CmmExpr
_ = Maybe CmmExpr
forall a. Maybe a
Nothing
isTrivialCmmExpr :: CmmExpr -> Bool
isTrivialCmmExpr :: CmmExpr -> Bool
isTrivialCmmExpr (CmmLoad CmmExpr
_ CmmType
_ AlignmentSpec
_) = Bool
False
isTrivialCmmExpr (CmmMachOp MachOp
_ [CmmExpr]
_) = Bool
False
isTrivialCmmExpr (CmmLit CmmLit
_) = Bool
True
isTrivialCmmExpr (CmmReg CmmReg
_) = Bool
True
isTrivialCmmExpr (CmmRegOff CmmReg
_ Int
_) = Bool
True
isTrivialCmmExpr (CmmStackSlot Area
_ Int
_) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"isTrivialCmmExpr CmmStackSlot"
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad CmmExpr
e CmmType
_ AlignmentSpec
_) = CmmExpr -> Bool
hasNoGlobalRegs CmmExpr
e
hasNoGlobalRegs (CmmMachOp MachOp
_ [CmmExpr]
es) = (CmmExpr -> Bool) -> [CmmExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CmmExpr -> Bool
hasNoGlobalRegs [CmmExpr]
es
hasNoGlobalRegs (CmmLit CmmLit
_) = Bool
True
hasNoGlobalRegs (CmmReg (CmmLocal LocalReg
_)) = Bool
True
hasNoGlobalRegs (CmmRegOff (CmmLocal LocalReg
_) Int
_) = Bool
True
hasNoGlobalRegs CmmExpr
_ = Bool
False
isLit :: CmmExpr -> Bool
isLit :: CmmExpr -> Bool
isLit (CmmLit CmmLit
_) = Bool
True
isLit CmmExpr
_ = Bool
False
isComparisonExpr :: CmmExpr -> Bool
isComparisonExpr :: CmmExpr -> Bool
isComparisonExpr (CmmMachOp MachOp
op [CmmExpr]
_) = MachOp -> Bool
isComparisonMachOp MachOp
op
isComparisonExpr CmmExpr
_ = Bool
False
type RegSet r = Set r
type LocalRegSet = RegSet LocalReg
type GlobalRegSet = RegSet GlobalReg
emptyRegSet :: RegSet r
nullRegSet :: RegSet r -> Bool
elemRegSet :: Ord r => r -> RegSet r -> Bool
extendRegSet :: Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
mkRegSet :: Ord r => [r] -> RegSet r
minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
sizeRegSet :: RegSet r -> Int
regSetToList :: RegSet r -> [r]
emptyRegSet :: forall r. RegSet r
emptyRegSet = Set r
forall r. RegSet r
Set.empty
nullRegSet :: forall r. RegSet r -> Bool
nullRegSet = Set r -> Bool
forall r. RegSet r -> Bool
Set.null
elemRegSet :: forall r. Ord r => r -> RegSet r -> Bool
elemRegSet = r -> Set r -> Bool
forall r. Ord r => r -> RegSet r -> Bool
Set.member
extendRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
extendRegSet = (r -> RegSet r -> RegSet r) -> RegSet r -> r -> RegSet r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> RegSet r -> RegSet r
forall a. Ord a => a -> Set a -> Set a
Set.insert
deleteFromRegSet :: forall r. Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet = (r -> RegSet r -> RegSet r) -> RegSet r -> r -> RegSet r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> RegSet r -> RegSet r
forall a. Ord a => a -> Set a -> Set a
Set.delete
mkRegSet :: forall r. Ord r => [r] -> RegSet r
mkRegSet = [r] -> Set r
forall r. Ord r => [r] -> RegSet r
Set.fromList
minusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
minusRegSet = Set r -> Set r -> Set r
forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.difference
plusRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
plusRegSet = Set r -> Set r -> Set r
forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.union
timesRegSet :: forall r. Ord r => RegSet r -> RegSet r -> RegSet r
timesRegSet = Set r -> Set r -> Set r
forall r. Ord r => RegSet r -> RegSet r -> RegSet r
Set.intersection
sizeRegSet :: forall r. RegSet r -> Int
sizeRegSet = Set r -> Int
forall r. RegSet r -> Int
Set.size
regSetToList :: forall r. RegSet r -> [r]
regSetToList = Set r -> [r]
forall r. RegSet r -> [r]
Set.toList
class Ord r => UserOfRegs r a where
foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b
foldLocalRegsUsed :: UserOfRegs LocalReg a
=> Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed :: forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed = Platform -> (b -> LocalReg -> b) -> b -> a -> b
forall b. Platform -> (b -> LocalReg -> b) -> b -> a -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed
class Ord r => DefinerOfRegs r a where
foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b
foldLocalRegsDefd :: DefinerOfRegs LocalReg a
=> Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsDefd :: forall a b.
DefinerOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsDefd = Platform -> (b -> LocalReg -> b) -> b -> a -> b
forall b. Platform -> (b -> LocalReg -> b) -> b -> a -> b
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd
instance UserOfRegs LocalReg CmmReg where
foldRegsUsed :: forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmReg -> b
foldRegsUsed Platform
_ b -> LocalReg -> b
f b
z (CmmLocal LocalReg
reg) = b -> LocalReg -> b
f b
z LocalReg
reg
foldRegsUsed Platform
_ b -> LocalReg -> b
_ b
z (CmmGlobal GlobalReg
_) = b
z
instance DefinerOfRegs LocalReg CmmReg where
foldRegsDefd :: forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmReg -> b
foldRegsDefd Platform
_ b -> LocalReg -> b
f b
z (CmmLocal LocalReg
reg) = b -> LocalReg -> b
f b
z LocalReg
reg
foldRegsDefd Platform
_ b -> LocalReg -> b
_ b
z (CmmGlobal GlobalReg
_) = b
z
instance UserOfRegs GlobalReg CmmReg where
{-# INLINEABLE foldRegsUsed #-}
foldRegsUsed :: forall b. Platform -> (b -> GlobalReg -> b) -> b -> CmmReg -> b
foldRegsUsed Platform
_ b -> GlobalReg -> b
_ b
z (CmmLocal LocalReg
_) = b
z
foldRegsUsed Platform
_ b -> GlobalReg -> b
f b
z (CmmGlobal GlobalReg
reg) = b -> GlobalReg -> b
f b
z GlobalReg
reg
instance DefinerOfRegs GlobalReg CmmReg where
foldRegsDefd :: forall b. Platform -> (b -> GlobalReg -> b) -> b -> CmmReg -> b
foldRegsDefd Platform
_ b -> GlobalReg -> b
_ b
z (CmmLocal LocalReg
_) = b
z
foldRegsDefd Platform
_ b -> GlobalReg -> b
f b
z (CmmGlobal GlobalReg
reg) = b -> GlobalReg -> b
f b
z GlobalReg
reg
instance Ord r => UserOfRegs r r where
foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> r -> b
foldRegsUsed Platform
_ b -> r -> b
f b
z r
r = b -> r -> b
f b
z r
r
instance Ord r => DefinerOfRegs r r where
foldRegsDefd :: forall b. Platform -> (b -> r -> b) -> b -> r -> b
foldRegsDefd Platform
_ b -> r -> b
f b
z r
r = b -> r -> b
f b
z r
r
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
{-# INLINEABLE foldRegsUsed #-}
foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> CmmExpr -> b
foldRegsUsed Platform
platform b -> r -> b
f !b
z CmmExpr
e = b -> CmmExpr -> b
expr b
z CmmExpr
e
where expr :: b -> CmmExpr -> b
expr b
z (CmmLit CmmLit
_) = b
z
expr b
z (CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_) = Platform -> (b -> r -> b) -> b -> CmmExpr -> b
forall b. Platform -> (b -> r -> b) -> b -> CmmExpr -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform b -> r -> b
f b
z CmmExpr
addr
expr b
z (CmmReg CmmReg
r) = Platform -> (b -> r -> b) -> b -> CmmReg -> b
forall b. Platform -> (b -> r -> b) -> b -> CmmReg -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform b -> r -> b
f b
z CmmReg
r
expr b
z (CmmMachOp MachOp
_ [CmmExpr]
exprs) = Platform -> (b -> r -> b) -> b -> [CmmExpr] -> b
forall b. Platform -> (b -> r -> b) -> b -> [CmmExpr] -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform b -> r -> b
f b
z [CmmExpr]
exprs
expr b
z (CmmRegOff CmmReg
r Int
_) = Platform -> (b -> r -> b) -> b -> CmmReg -> b
forall b. Platform -> (b -> r -> b) -> b -> CmmReg -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform b -> r -> b
f b
z CmmReg
r
expr b
z (CmmStackSlot Area
_ Int
_) = b
z
instance UserOfRegs r a => UserOfRegs r [a] where
foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> [a] -> b
foldRegsUsed Platform
platform b -> r -> b
f b
set [a]
as = (b -> a -> b) -> b -> [a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Platform -> (b -> r -> b) -> b -> a -> b
forall b. Platform -> (b -> r -> b) -> b -> a -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform b -> r -> b
f) b
set [a]
as
{-# INLINABLE foldRegsUsed #-}
instance DefinerOfRegs r a => DefinerOfRegs r [a] where
foldRegsDefd :: forall b. Platform -> (b -> r -> b) -> b -> [a] -> b
foldRegsDefd Platform
platform b -> r -> b
f b
set [a]
as = (b -> a -> b) -> b -> [a] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Platform -> (b -> r -> b) -> b -> a -> b
forall b. Platform -> (b -> r -> b) -> b -> a -> b
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform b -> r -> b
f) b
set [a]
as
{-# INLINABLE foldRegsDefd #-}
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
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
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
forall doc. IsLine doc => String -> doc
text String
"==")
infixMachOp1 (MO_Ne Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"!=")
infixMachOp1 (MO_Shl Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<<")
infixMachOp1 (MO_U_Shr Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">>")
infixMachOp1 (MO_U_Ge Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">=")
infixMachOp1 (MO_U_Le Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<=")
infixMachOp1 (MO_U_Gt Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>')
infixMachOp1 (MO_U_Lt Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'<')
infixMachOp1 MachOp
_ = Maybe SDoc
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 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
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
forall doc. IsLine doc => Char -> doc
char Char
'+')
infixMachOp7 (MO_Sub Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'-')
infixMachOp7 MachOp
_ = Maybe SDoc
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
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
forall doc. IsLine doc => Char -> doc
char Char
'/')
infixMachOp8 (MO_Mul Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'*')
infixMachOp8 (MO_U_Rem Width
_) = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (Char -> SDoc
forall doc. IsLine doc => Char -> doc
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
forall doc. IsOutput doc => doc
empty
AlignmentSpec
Unaligned -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"^"
in CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align_mark SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
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
forall doc. IsLine doc => doc -> doc
parens (CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'+' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
off)
CmmStackSlot Area
a Int
off -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Area -> SDoc
forall a. Outputable a => a -> SDoc
ppr Area
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'+' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
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
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
y
[CmmExpr
x] -> SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CmmExpr -> SDoc
pprExpr9 Platform
platform CmmExpr
x
[CmmExpr]
_ -> String -> SDoc -> SDoc -> SDoc
forall a. String -> SDoc -> a -> a
pprTrace String
"GHC.Cmm.Expr.genMachOp: machop with strange number of args"
(MachOp -> SDoc
pprMachOp MachOp
mop SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform) [CmmExpr]
args)))
SDoc
forall doc. IsOutput doc => doc
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
forall doc. IsLine doc => doc -> doc
parens (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr]
args))
| Bool
otherwise = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'%' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ppr_op SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
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
forall doc. IsLine doc => String -> doc
text ((Char -> Char) -> ShowS
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))
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
forall doc. IsLine doc => Char -> doc
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
forall doc. IsLine doc => Char -> doc
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
forall doc. IsLine doc => Char -> doc
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
forall doc. IsLine doc => Char -> doc
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
forall doc. IsLine doc => Char -> doc
char Char
'-'
MachOp
_ -> Maybe SDoc
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
forall doc. IsLine doc => [doc] -> doc
hcat [ (if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens else SDoc -> SDoc
forall a. a -> a
id)(Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i)
, Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
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
forall doc. IsLine doc => doc
space SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
rep ]
CmmFloat Rational
f Width
rep -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Double -> SDoc
forall doc. IsLine doc => Double -> doc
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
forall doc. IsLine doc => Char -> doc
char Char
'<' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [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
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
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
forall doc. IsLine doc => doc -> doc -> doc
<> 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
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'-'
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clbl2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
ppr_offset Int
i
CmmBlock BlockId
id -> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
id
CmmLit
CmmHighStackMark -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<highSp>"
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 Platform
platform lit :: CmmLit
lit@(CmmLabelOff {}) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
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
forall doc. IsOutput doc => doc
empty
| Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'+' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i
| Bool
otherwise = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'-' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (-Int
i)
commafy :: [SDoc] -> SDoc
commafy :: [SDoc] -> SDoc
commafy [SDoc]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
xs