{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}
module GHC.Cmm (
CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
CmmDataDecl, cmmDataDeclCmmDecl,
CmmGraph, GenCmmGraph(..),
toBlockMap, revPostorder, toBlockList,
CmmBlock, RawCmmDecl,
Section(..), SectionType(..),
GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
SectionProtection(..), sectionProtection,
GenBasicBlock(..), blockId,
ListGraph(..), pprBBlock,
CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
ClosureTypeInfo(..),
ProfilingInfo(..), ConstrDescription,
module GHC.Cmm.Node,
module GHC.Cmm.Expr,
pprCmmGroup, pprSection, pprStatic
) where
import GHC.Prelude
import GHC.Platform
import GHC.Types.Id
import GHC.Types.CostCentre
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Node
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Expr
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Utils.Outputable
import Data.Void (Void)
import Data.List (intersperse)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
type CmmProgram = [CmmGroup]
type GenCmmGroup d h g = [GenCmmDecl d h g]
type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
type CmmGroupSRTs = GenCmmGroup RawCmmStatics CmmTopInfo CmmGraph
type RawCmmGroup = GenCmmGroup RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
data GenCmmDecl d h g
= CmmProc
h
CLabel
[GlobalReg]
g
| CmmData
Section
d
deriving ((forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b)
-> (forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a)
-> Functor (GenCmmDecl d h)
forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
fmap :: forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
$c<$ :: forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
<$ :: forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
Functor)
instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
=> OutputableP Platform (GenCmmDecl d info i) where
pdoc :: Platform -> GenCmmDecl d info i -> SDoc
pdoc = Platform -> GenCmmDecl d info i -> SDoc
forall d info i.
(OutputableP Platform d, OutputableP Platform info,
OutputableP Platform i) =>
Platform -> GenCmmDecl d info i -> SDoc
pprTop
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
type CmmDataDecl = GenCmmDataDecl CmmStatics
type GenCmmDataDecl d = GenCmmDecl d Void Void
cmmDataDeclCmmDecl :: GenCmmDataDecl d -> GenCmmDecl d h g
cmmDataDeclCmmDecl :: forall d h g. GenCmmDataDecl d -> GenCmmDecl d h g
cmmDataDeclCmmDecl = \ case
CmmProc Void
void CLabel
_ [GlobalReg]
_ Void
_ -> case Void
void of
CmmData Section
section d
d -> Section -> d -> GenCmmDecl d h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
section d
d
{-# INLINE cmmDataDeclCmmDecl #-}
type RawCmmDecl
= GenCmmDecl
RawCmmStatics
(LabelMap RawCmmStatics)
CmmGraph
type CmmGraph = GenCmmGraph CmmNode
data GenCmmGraph n = CmmGraph { forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry :: BlockId, forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Graph n C C
g_graph :: Graph n C C }
type CmmBlock = Block CmmNode C C
instance OutputableP Platform CmmGraph where
pdoc :: Platform -> CmmGraph -> SDoc
pdoc = Platform -> CmmGraph -> SDoc
pprCmmGraph
toBlockMap :: CmmGraph -> LabelMap CmmBlock
toBlockMap :: CmmGraph -> LabelMap CmmBlock
toBlockMap (CmmGraph {g_graph :: forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Graph n C C
g_graph=GMany MaybeO C (Block CmmNode O C)
NothingO LabelMap CmmBlock
body MaybeO C (Block CmmNode C O)
NothingO}) = LabelMap CmmBlock
body
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph Platform
platform CmmGraph
g
= FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"{" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"offset"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ ByteOff -> SDoc -> SDoc
nest ByteOff
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmBlock -> SDoc) -> [CmmBlock] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmBlock -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform) [CmmBlock]
blocks)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"}"
where blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g
revPostorder :: CmmGraph -> [CmmBlock]
revPostorder :: CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g = {-# SCC "revPostorder" #-}
LabelMap CmmBlock -> BlockId -> [CmmBlock]
forall (block :: Extensibility -> Extensibility -> *).
NonLocal block =>
LabelMap (block C C) -> BlockId -> [block C C]
revPostorderFrom (CmmGraph -> LabelMap CmmBlock
toBlockMap CmmGraph
g) (CmmGraph -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
g)
toBlockList :: CmmGraph -> [CmmBlock]
toBlockList :: CmmGraph -> [CmmBlock]
toBlockList CmmGraph
g = LabelMap CmmBlock -> [CmmBlock]
forall a. LabelMap a -> [a]
forall (map :: * -> *) a. IsMap map => map a -> [a]
mapElems (LabelMap CmmBlock -> [CmmBlock])
-> LabelMap CmmBlock -> [CmmBlock]
forall a b. (a -> b) -> a -> b
$ CmmGraph -> LabelMap CmmBlock
toBlockMap CmmGraph
g
data CmmTopInfo = TopInfo { CmmTopInfo -> LabelMap CmmInfoTable
info_tbls :: LabelMap CmmInfoTable
, CmmTopInfo -> CmmStackInfo
stack_info :: CmmStackInfo }
instance OutputableP Platform CmmTopInfo where
pdoc :: Platform -> CmmTopInfo -> SDoc
pdoc = Platform -> CmmTopInfo -> SDoc
pprTopInfo
pprTopInfo :: Platform -> CmmTopInfo -> SDoc
pprTopInfo :: Platform -> CmmTopInfo -> SDoc
pprTopInfo Platform
platform (TopInfo {info_tbls :: CmmTopInfo -> LabelMap CmmInfoTable
info_tbls=LabelMap CmmInfoTable
info_tbl, stack_info :: CmmTopInfo -> CmmStackInfo
stack_info=CmmStackInfo
stack_info}) =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"info_tbls: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> LabelMap CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform LabelMap CmmInfoTable
info_tbl,
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"stack_info: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmStackInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmStackInfo
stack_info]
topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable :: forall a (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable (CmmProc CmmTopInfo
infos CLabel
_ [GlobalReg]
_ GenCmmGraph n
g) = KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph n -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph n
g) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
infos)
topInfoTable GenCmmDecl a CmmTopInfo (GenCmmGraph n)
_ = Maybe CmmInfoTable
forall a. Maybe a
Nothing
data CmmStackInfo
= StackInfo {
CmmStackInfo -> ByteOff
arg_space :: ByteOff,
CmmStackInfo -> Bool
do_layout :: Bool
}
instance Outputable CmmStackInfo where
ppr :: CmmStackInfo -> SDoc
ppr = CmmStackInfo -> SDoc
pprStackInfo
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo (StackInfo {arg_space :: CmmStackInfo -> ByteOff
arg_space=ByteOff
arg_space}) =
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"arg_space: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
arg_space
data CmmInfoTable
= CmmInfoTable {
CmmInfoTable -> CLabel
cit_lbl :: CLabel,
CmmInfoTable -> SMRep
cit_rep :: SMRep,
CmmInfoTable -> ProfilingInfo
cit_prof :: ProfilingInfo,
CmmInfoTable -> Maybe CLabel
cit_srt :: Maybe CLabel,
CmmInfoTable -> Maybe (Id, CostCentreStack)
cit_clo :: Maybe (Id, CostCentreStack)
} deriving (CmmInfoTable -> CmmInfoTable -> Bool
(CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool) -> Eq CmmInfoTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmInfoTable -> CmmInfoTable -> Bool
== :: CmmInfoTable -> CmmInfoTable -> Bool
$c/= :: CmmInfoTable -> CmmInfoTable -> Bool
/= :: CmmInfoTable -> CmmInfoTable -> Bool
Eq, Eq CmmInfoTable
Eq CmmInfoTable =>
(CmmInfoTable -> CmmInfoTable -> Ordering)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> CmmInfoTable)
-> (CmmInfoTable -> CmmInfoTable -> CmmInfoTable)
-> Ord CmmInfoTable
CmmInfoTable -> CmmInfoTable -> Bool
CmmInfoTable -> CmmInfoTable -> Ordering
CmmInfoTable -> CmmInfoTable -> CmmInfoTable
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 :: CmmInfoTable -> CmmInfoTable -> Ordering
compare :: CmmInfoTable -> CmmInfoTable -> Ordering
$c< :: CmmInfoTable -> CmmInfoTable -> Bool
< :: CmmInfoTable -> CmmInfoTable -> Bool
$c<= :: CmmInfoTable -> CmmInfoTable -> Bool
<= :: CmmInfoTable -> CmmInfoTable -> Bool
$c> :: CmmInfoTable -> CmmInfoTable -> Bool
> :: CmmInfoTable -> CmmInfoTable -> Bool
$c>= :: CmmInfoTable -> CmmInfoTable -> Bool
>= :: CmmInfoTable -> CmmInfoTable -> Bool
$cmax :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
max :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
$cmin :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
min :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
Ord)
instance OutputableP Platform CmmInfoTable where
pdoc :: Platform -> CmmInfoTable -> SDoc
pdoc = Platform -> CmmInfoTable -> SDoc
pprInfoTable
data ProfilingInfo
= NoProfilingInfo
| ProfilingInfo ByteString ByteString
deriving (ProfilingInfo -> ProfilingInfo -> Bool
(ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool) -> Eq ProfilingInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingInfo -> ProfilingInfo -> Bool
== :: ProfilingInfo -> ProfilingInfo -> Bool
$c/= :: ProfilingInfo -> ProfilingInfo -> Bool
/= :: ProfilingInfo -> ProfilingInfo -> Bool
Eq, Eq ProfilingInfo
Eq ProfilingInfo =>
(ProfilingInfo -> ProfilingInfo -> Ordering)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> ProfilingInfo)
-> (ProfilingInfo -> ProfilingInfo -> ProfilingInfo)
-> Ord ProfilingInfo
ProfilingInfo -> ProfilingInfo -> Bool
ProfilingInfo -> ProfilingInfo -> Ordering
ProfilingInfo -> ProfilingInfo -> ProfilingInfo
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 :: ProfilingInfo -> ProfilingInfo -> Ordering
compare :: ProfilingInfo -> ProfilingInfo -> Ordering
$c< :: ProfilingInfo -> ProfilingInfo -> Bool
< :: ProfilingInfo -> ProfilingInfo -> Bool
$c<= :: ProfilingInfo -> ProfilingInfo -> Bool
<= :: ProfilingInfo -> ProfilingInfo -> Bool
$c> :: ProfilingInfo -> ProfilingInfo -> Bool
> :: ProfilingInfo -> ProfilingInfo -> Bool
$c>= :: ProfilingInfo -> ProfilingInfo -> Bool
>= :: ProfilingInfo -> ProfilingInfo -> Bool
$cmax :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
max :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
$cmin :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
min :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
Ord)
data SectionType
= Text
| Data
| ReadOnlyData
| RelocatableReadOnlyData
| UninitialisedData
| InitArray
| FiniArray
| CString
| OtherSection String
deriving (ByteOff -> SectionType -> ShowS
[SectionType] -> ShowS
SectionType -> FilePath
(ByteOff -> SectionType -> ShowS)
-> (SectionType -> FilePath)
-> ([SectionType] -> ShowS)
-> Show SectionType
forall a.
(ByteOff -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ByteOff -> SectionType -> ShowS
showsPrec :: ByteOff -> SectionType -> ShowS
$cshow :: SectionType -> FilePath
show :: SectionType -> FilePath
$cshowList :: [SectionType] -> ShowS
showList :: [SectionType] -> ShowS
Show)
data SectionProtection
= ReadWriteSection
| ReadOnlySection
| WriteProtectedSection
deriving (SectionProtection -> SectionProtection -> Bool
(SectionProtection -> SectionProtection -> Bool)
-> (SectionProtection -> SectionProtection -> Bool)
-> Eq SectionProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SectionProtection -> SectionProtection -> Bool
== :: SectionProtection -> SectionProtection -> Bool
$c/= :: SectionProtection -> SectionProtection -> Bool
/= :: SectionProtection -> SectionProtection -> Bool
Eq)
sectionProtection :: Section -> SectionProtection
sectionProtection :: Section -> SectionProtection
sectionProtection (Section SectionType
t CLabel
_) = case SectionType
t of
SectionType
Text -> SectionProtection
ReadOnlySection
SectionType
ReadOnlyData -> SectionProtection
ReadOnlySection
SectionType
RelocatableReadOnlyData -> SectionProtection
WriteProtectedSection
SectionType
InitArray -> SectionProtection
ReadOnlySection
SectionType
FiniArray -> SectionProtection
ReadOnlySection
SectionType
CString -> SectionProtection
ReadOnlySection
SectionType
Data -> SectionProtection
ReadWriteSection
SectionType
UninitialisedData -> SectionProtection
ReadWriteSection
(OtherSection FilePath
_) -> SectionProtection
ReadWriteSection
data Section = Section SectionType CLabel
data CmmStatic
= CmmStaticLit CmmLit
| CmmUninitialised Int
| CmmString ByteString
| CmmFileEmbed FilePath Int
instance OutputableP Platform CmmStatic where
pdoc :: Platform -> CmmStatic -> SDoc
pdoc = Platform -> CmmStatic -> SDoc
pprStatic
instance Outputable CmmStatic where
ppr :: CmmStatic -> SDoc
ppr (CmmStaticLit CmmLit
lit) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmStaticLit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit
ppr (CmmUninitialised ByteOff
n) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmUninitialised" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
n
ppr (CmmString ByteString
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmString"
ppr (CmmFileEmbed FilePath
fp ByteOff
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmFileEmbed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
fp
data GenCmmStatics (rawOnly :: Bool) where
CmmStatics
:: CLabel
-> CmmInfoTable
-> CostCentreStack
-> [CmmLit]
-> [CmmLit]
-> GenCmmStatics 'False
CmmStaticsRaw
:: CLabel
-> [CmmStatic]
-> GenCmmStatics a
instance OutputableP Platform (GenCmmStatics a) where
pdoc :: Platform -> GenCmmStatics a -> SDoc
pdoc = Platform -> GenCmmStatics a -> SDoc
forall (a :: Bool). Platform -> GenCmmStatics a -> SDoc
pprStatics
type CmmStatics = GenCmmStatics 'False
type RawCmmStatics = GenCmmStatics 'True
data GenBasicBlock i
= BasicBlock BlockId [i]
deriving ((forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b)
-> (forall a b. a -> GenBasicBlock b -> GenBasicBlock a)
-> Functor GenBasicBlock
forall a b. a -> GenBasicBlock b -> GenBasicBlock a
forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
fmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
$c<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
Functor)
blockId :: GenBasicBlock i -> BlockId
blockId :: forall i. GenBasicBlock i -> BlockId
blockId (BasicBlock BlockId
blk_id [i]
_ ) = BlockId
blk_id
newtype ListGraph i
= ListGraph [GenBasicBlock i]
deriving ((forall a b. (a -> b) -> ListGraph a -> ListGraph b)
-> (forall a b. a -> ListGraph b -> ListGraph a)
-> Functor ListGraph
forall a b. a -> ListGraph b -> ListGraph a
forall a b. (a -> b) -> ListGraph a -> ListGraph b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
fmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
$c<$ :: forall a b. a -> ListGraph b -> ListGraph a
<$ :: forall a b. a -> ListGraph b -> ListGraph a
Functor)
instance Outputable instr => Outputable (ListGraph instr) where
ppr :: ListGraph instr -> SDoc
ppr (ListGraph [GenBasicBlock instr]
blocks) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenBasicBlock instr -> SDoc) -> [GenBasicBlock instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenBasicBlock instr]
blocks)
instance OutputableP env instr => OutputableP env (ListGraph instr) where
pdoc :: env -> ListGraph instr -> SDoc
pdoc env
env ListGraph instr
g = ListGraph SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((instr -> SDoc) -> ListGraph instr -> ListGraph SDoc
forall a b. (a -> b) -> ListGraph a -> ListGraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> instr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) ListGraph instr
g)
instance Outputable instr => Outputable (GenBasicBlock instr) where
ppr :: GenBasicBlock instr -> SDoc
ppr = GenBasicBlock instr -> SDoc
forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock
instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
pdoc :: env -> GenBasicBlock instr -> SDoc
pdoc env
env GenBasicBlock instr
block = GenBasicBlock SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((instr -> SDoc) -> GenBasicBlock instr -> GenBasicBlock SDoc
forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> instr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) GenBasicBlock instr
block)
pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock :: forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock (BasicBlock BlockId
ident [stmt]
stmts) =
SDoc -> ByteOff -> SDoc -> SDoc
hang (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
ident SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) ByteOff
4 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((stmt -> SDoc) -> [stmt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map stmt -> SDoc
forall a. Outputable a => a -> SDoc
ppr [stmt]
stmts))
pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
=> Platform -> GenCmmGroup d info g -> SDoc
pprCmmGroup :: forall d info g.
(OutputableP Platform d, OutputableP Platform info,
OutputableP Platform g) =>
Platform -> GenCmmGroup d info g -> SDoc
pprCmmGroup Platform
platform GenCmmGroup d info g
tops
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
blankLine ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (GenCmmDecl d info g -> SDoc) -> GenCmmGroup d info g -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> GenCmmDecl d info g -> SDoc
forall d info i.
(OutputableP Platform d, OutputableP Platform info,
OutputableP Platform i) =>
Platform -> GenCmmDecl d info i -> SDoc
pprTop Platform
platform) GenCmmGroup d info g
tops
pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
=> Platform -> GenCmmDecl d info i -> SDoc
pprTop :: forall d info i.
(OutputableP Platform d, OutputableP Platform info,
OutputableP Platform i) =>
Platform -> GenCmmDecl d info i -> SDoc
pprTop Platform
platform (CmmProc info
info CLabel
lbl [GlobalReg]
live i
graph)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
lparen SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
rparen SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
lbrace SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"// " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GlobalReg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalReg]
live
, ByteOff -> SDoc -> SDoc
nest ByteOff
8 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
forall doc. IsLine doc => doc
lbrace SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> info -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform info
info SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
forall doc. IsLine doc => doc
rbrace
, ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Platform -> i -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform i
graph
, SDoc
forall doc. IsLine doc => doc
rbrace ]
pprTop Platform
platform (CmmData Section
section d
ds) =
(SDoc -> ByteOff -> SDoc -> SDoc
hang (Platform -> Section -> SDoc
pprSection Platform
platform Section
section SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
lbrace) ByteOff
4 (Platform -> d -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform d
ds))
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
forall doc. IsLine doc => doc
rbrace
pprInfoTable :: Platform -> CmmInfoTable -> SDoc
pprInfoTable :: Platform -> CmmInfoTable -> SDoc
pprInfoTable Platform
platform (CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
cit_lbl = CLabel
lbl, cit_rep :: CmmInfoTable -> SMRep
cit_rep = SMRep
rep
, cit_prof :: CmmInfoTable -> ProfilingInfo
cit_prof = ProfilingInfo
prof_info
, cit_srt :: CmmInfoTable -> Maybe CLabel
cit_srt = Maybe CLabel
srt })
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"label: " 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
lbl
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"rep: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SMRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr SMRep
rep
, case ProfilingInfo
prof_info of
ProfilingInfo
NoProfilingInfo -> SDoc
forall doc. IsOutput doc => doc
empty
ProfilingInfo ByteString
ct ByteString
cd ->
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"type: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
ct))
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"desc: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
cd)) ]
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"srt: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Maybe CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe CLabel
srt ]
pprStatics :: Platform -> GenCmmStatics a -> SDoc
pprStatics :: forall (a :: Bool). Platform -> GenCmmStatics a -> SDoc
pprStatics Platform
platform (CmmStatics CLabel
lbl CmmInfoTable
itbl CostCentreStack
ccs [CmmLit]
payload [CmmLit]
extras) =
Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmInfoTable
itbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CmmLit] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CmmLit]
payload SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [CmmLit] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmLit]
extras
pprStatics Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
ds) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> SDoc
pprStatic Platform
platform) [CmmStatic]
ds)
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic Platform
platform CmmStatic
s = case CmmStatic
s of
CmmStaticLit CmmLit
lit -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"const" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmLit -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmLit
lit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi
CmmUninitialised ByteOff
i -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"I8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (ByteOff -> SDoc
forall doc. IsLine doc => ByteOff -> doc
int ByteOff
i)
CmmString ByteString
s' -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"I8[]" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
s')
CmmFileEmbed FilePath
path ByteOff
_ -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"incbin " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ShowS
forall a. Show a => a -> FilePath
show FilePath
path)
pprSection :: Platform -> Section -> SDoc
pprSection :: Platform -> Section -> SDoc
pprSection Platform
platform (Section SectionType
t CLabel
suffix) =
SDoc
section SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (SectionType -> SDoc
pprSectionType SectionType
t 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
suffix)
where
section :: SDoc
section = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"section"
pprSectionType :: SectionType -> SDoc
pprSectionType :: SectionType -> SDoc
pprSectionType SectionType
s = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ case SectionType
s of
SectionType
Text -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"text"
SectionType
Data -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"data"
SectionType
ReadOnlyData -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"readonly"
SectionType
RelocatableReadOnlyData -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"relreadonly"
SectionType
UninitialisedData -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"uninitialised"
SectionType
InitArray -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"initarray"
SectionType
FiniArray -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"finiarray"
SectionType
CString -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"cstring"
OtherSection FilePath
s' -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
s'