{-# LANGUAGE GADTs #-}
module Cmm (
CmmProgram, CmmGroup, GenCmmGroup,
CmmDecl, GenCmmDecl(..),
CmmGraph, GenCmmGraph(..),
CmmBlock,
RawCmmDecl, RawCmmGroup,
Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
SectionProtection(..), sectionProtection,
GenBasicBlock(..), blockId,
ListGraph(..), pprBBlock,
CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
ClosureTypeInfo(..),
ProfilingInfo(..), ConstrDescription,
module CmmNode,
module CmmExpr,
) where
import GhcPrelude
import Id
import CostCentre
import CLabel
import BlockId
import CmmNode
import SMRep
import CmmExpr
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Graph
import Hoopl.Label
import Outputable
import Data.ByteString (ByteString)
type CmmProgram = [CmmGroup]
type GenCmmGroup d h g = [GenCmmDecl d h g]
type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
type RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) CmmGraph
data GenCmmDecl d h g
= CmmProc
h
CLabel
[GlobalReg]
g
| CmmData
Section
d
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type RawCmmDecl
= GenCmmDecl
CmmStatics
(LabelMap CmmStatics)
CmmGraph
type CmmGraph = GenCmmGraph CmmNode
data GenCmmGraph n = CmmGraph { GenCmmGraph n -> BlockId
g_entry :: BlockId, GenCmmGraph n -> Graph n C C
g_graph :: Graph n C C }
type CmmBlock = Block CmmNode C C
data CmmTopInfo = TopInfo { CmmTopInfo -> LabelMap CmmInfoTable
info_tbls :: LabelMap CmmInfoTable
, CmmTopInfo -> CmmStackInfo
stack_info :: CmmStackInfo }
topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable (CmmProc CmmTopInfo
infos CLabel
_ [GlobalReg]
_ GenCmmGraph n
g) = KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
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 -> Maybe ByteOff
updfr_space :: Maybe ByteOff,
CmmStackInfo -> Bool
do_layout :: Bool
}
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)
}
data ProfilingInfo
= NoProfilingInfo
| ProfilingInfo ByteString ByteString
data SectionType
= Text
| Data
| ReadOnlyData
| RelocatableReadOnlyData
| UninitialisedData
| ReadOnlyData16
| CString
| OtherSection String
deriving (ByteOff -> SectionType -> ShowS
[SectionType] -> ShowS
SectionType -> String
(ByteOff -> SectionType -> ShowS)
-> (SectionType -> String)
-> ([SectionType] -> ShowS)
-> Show SectionType
forall a.
(ByteOff -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SectionType] -> ShowS
$cshowList :: [SectionType] -> ShowS
show :: SectionType -> String
$cshow :: SectionType -> String
showsPrec :: ByteOff -> SectionType -> ShowS
$cshowsPrec :: ByteOff -> 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
/= :: SectionProtection -> SectionProtection -> Bool
$c/= :: SectionProtection -> SectionProtection -> Bool
== :: SectionProtection -> SectionProtection -> Bool
$c== :: 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
ReadOnlyData16 -> SectionProtection
ReadOnlySection
SectionType
CString -> SectionProtection
ReadOnlySection
SectionType
Data -> SectionProtection
ReadWriteSection
SectionType
UninitialisedData -> SectionProtection
ReadWriteSection
(OtherSection String
_) -> SectionProtection
ReadWriteSection
data Section = Section SectionType CLabel
data CmmStatic
= CmmStaticLit CmmLit
| CmmUninitialised Int
| CmmString ByteString
data CmmStatics
= Statics
CLabel
[CmmStatic]
data GenBasicBlock i = BasicBlock BlockId [i]
blockId :: GenBasicBlock i -> BlockId
blockId :: GenBasicBlock i -> BlockId
blockId (BasicBlock BlockId
blk_id [i]
_ ) = BlockId
blk_id
newtype ListGraph i = ListGraph [GenBasicBlock i]
instance Outputable instr => Outputable (ListGraph instr) where
ppr :: ListGraph instr -> SDoc
ppr (ListGraph [GenBasicBlock instr]
blocks) = [SDoc] -> SDoc
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 Outputable instr => Outputable (GenBasicBlock instr) where
ppr :: GenBasicBlock instr -> SDoc
ppr = GenBasicBlock instr -> SDoc
forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock
pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock :: GenBasicBlock stmt -> 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
<> SDoc
colon) ByteOff
4 ([SDoc] -> SDoc
vcat ((stmt -> SDoc) -> [stmt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map stmt -> SDoc
forall a. Outputable a => a -> SDoc
ppr [stmt]
stmts))