{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Cmm.Ppr.Decl
( pprCmms, pprCmmGroup, pprSection, pprStatic
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Cmm.Ppr.Expr
import GHC.Cmm
import GHC.Utils.Outputable
import Data.List (intersperse)
import qualified Data.ByteString as BS
pprCmms :: (OutputableP Platform info, OutputableP Platform g)
=> Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
pprCmms :: forall info g.
(OutputableP Platform info, OutputableP Platform g) =>
Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
pprCmms Platform
platform [GenCmmGroup RawCmmStatics info g]
cmms = LabelStyle -> SDoc -> SDoc
pprCode LabelStyle
CStyle ([SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
separator ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (GenCmmGroup RawCmmStatics info g -> SDoc)
-> [GenCmmGroup RawCmmStatics info g] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> GenCmmGroup RawCmmStatics info g -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform) [GenCmmGroup RawCmmStatics info g]
cmms))
where
separator :: SDoc
separator = SDoc
space SDoc -> SDoc -> SDoc
$$ FilePath -> SDoc
text FilePath
"-------------------" SDoc -> SDoc -> SDoc
$$ SDoc
space
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
instance OutputableP Platform (GenCmmStatics a) where
pdoc :: Platform -> GenCmmStatics a -> SDoc
pdoc = Platform -> GenCmmStatics a -> SDoc
forall (a :: Bool). Platform -> GenCmmStatics a -> SDoc
pprStatics
instance OutputableP Platform CmmStatic where
pdoc :: Platform -> CmmStatic -> SDoc
pdoc = Platform -> CmmStatic -> SDoc
pprStatic
instance OutputableP Platform CmmInfoTable where
pdoc :: Platform -> CmmInfoTable -> SDoc
pdoc = Platform -> CmmInfoTable -> SDoc
pprInfoTable
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
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
vcat [ Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> SDoc
rparen SDoc -> SDoc -> SDoc
<+> SDoc
lbrace SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
"// " SDoc -> SDoc -> SDoc
<+> [GlobalReg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalReg]
live
, Int -> SDoc -> SDoc
nest Int
8 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
lbrace SDoc -> SDoc -> SDoc
<+> Platform -> info -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform info
info SDoc -> SDoc -> SDoc
$$ SDoc
rbrace
, Int -> SDoc -> SDoc
nest Int
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
rbrace ]
pprTop Platform
platform (CmmData Section
section d
ds) =
(SDoc -> Int -> SDoc -> SDoc
hang (Platform -> Section -> SDoc
pprSection Platform
platform Section
section SDoc -> SDoc -> SDoc
<+> SDoc
lbrace) Int
4 (Platform -> d -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform d
ds))
SDoc -> SDoc -> SDoc
$$ SDoc
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
vcat [ FilePath -> SDoc
text FilePath
"label: " SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
, FilePath -> SDoc
text FilePath
"rep: " SDoc -> SDoc -> SDoc
<> SMRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr SMRep
rep
, case ProfilingInfo
prof_info of
ProfilingInfo
NoProfilingInfo -> SDoc
empty
ProfilingInfo ByteString
ct ByteString
cd ->
[SDoc] -> SDoc
vcat [ FilePath -> SDoc
text FilePath
"type: " SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
ct))
, FilePath -> SDoc
text FilePath
"desc: " SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
cd)) ]
, FilePath -> SDoc
text FilePath
"srt: " SDoc -> SDoc -> SDoc
<> Platform -> Maybe CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe CLabel
srt ]
instance Outputable ForeignHint where
ppr :: ForeignHint -> SDoc
ppr ForeignHint
NoHint = SDoc
empty
ppr ForeignHint
SignedHint = SDoc -> SDoc
quotes(FilePath -> SDoc
text FilePath
"signed")
ppr ForeignHint
AddrHint = (FilePath -> SDoc
text FilePath
"PtrHint")
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) =
Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Platform -> CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmInfoTable
itbl SDoc -> SDoc -> SDoc
<+> CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs SDoc -> SDoc -> SDoc
<+> Platform -> [CmmLit] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CmmLit]
payload
pprStatics Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
ds) = [SDoc] -> SDoc
vcat ((Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc
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 -> Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
text FilePath
"const" SDoc -> SDoc -> SDoc
<+> Platform -> CmmLit -> SDoc
pprLit Platform
platform CmmLit
lit SDoc -> SDoc -> SDoc
<> SDoc
semi
CmmUninitialised Int
i -> Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
text FilePath
"I8" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Int -> SDoc
int Int
i)
CmmString ByteString
s' -> Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
text FilePath
"I8[]" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
s')
CmmFileEmbed FilePath
path -> Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
text FilePath
"incbin " SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text (FilePath -> FilePath
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
<+> SDoc -> SDoc
doubleQuotes (SectionType -> SDoc
pprSectionType SectionType
t SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'.' SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
suffix)
where
section :: SDoc
section = FilePath -> SDoc
text FilePath
"section"
pprSectionType :: SectionType -> SDoc
pprSectionType :: SectionType -> SDoc
pprSectionType SectionType
s = SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ case SectionType
s of
SectionType
Text -> FilePath -> SDoc
text FilePath
"text"
SectionType
Data -> FilePath -> SDoc
text FilePath
"data"
SectionType
ReadOnlyData -> FilePath -> SDoc
text FilePath
"readonly"
SectionType
ReadOnlyData16 -> FilePath -> SDoc
text FilePath
"readonly16"
SectionType
RelocatableReadOnlyData -> FilePath -> SDoc
text FilePath
"relreadonly"
SectionType
UninitialisedData -> FilePath -> SDoc
text FilePath
"uninitialised"
SectionType
InitArray -> FilePath -> SDoc
text FilePath
"initarray"
SectionType
FiniArray -> FilePath -> SDoc
text FilePath
"finiarray"
SectionType
CString -> FilePath -> SDoc
text FilePath
"cstring"
OtherSection FilePath
s' -> FilePath -> SDoc
text FilePath
s'