{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Cmm.Ppr
( module GHC.Cmm.Ppr.Decl
, module GHC.Cmm.Ppr.Expr
)
where
import GHC.Prelude hiding (succ)
import GHC.Platform
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Cmm.Ppr.Decl
import GHC.Cmm.Ppr.Expr
import GHC.Utils.Misc
import GHC.Types.Basic
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
instance Outputable CmmStackInfo where
ppr :: CmmStackInfo -> SDoc
ppr = CmmStackInfo -> SDoc
pprStackInfo
instance OutputableP Platform CmmTopInfo where
pdoc :: Platform -> CmmTopInfo -> SDoc
pdoc = Platform -> CmmTopInfo -> SDoc
pprTopInfo
instance OutputableP Platform (CmmNode e x) where
pdoc :: Platform -> CmmNode e x -> SDoc
pdoc = Platform -> CmmNode e x -> SDoc
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> SDoc
pprNode
instance Outputable Convention where
ppr :: Convention -> SDoc
ppr = Convention -> SDoc
pprConvention
instance Outputable ForeignConvention where
ppr :: ForeignConvention -> SDoc
ppr = ForeignConvention -> SDoc
pprForeignConvention
instance OutputableP Platform ForeignTarget where
pdoc :: Platform -> ForeignTarget -> SDoc
pdoc = Platform -> ForeignTarget -> SDoc
pprForeignTarget
instance Outputable CmmReturnInfo where
ppr :: CmmReturnInfo -> SDoc
ppr = CmmReturnInfo -> SDoc
pprReturnInfo
instance OutputableP Platform (Block CmmNode C C) where
pdoc :: Platform -> CmmBlock -> SDoc
pdoc = Platform -> CmmBlock -> SDoc
forall (x :: Extensibility) (e :: Extensibility).
(IndexedCO x SDoc SDoc ~ SDoc) =>
Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance OutputableP Platform (Block CmmNode C O) where
pdoc :: Platform -> Block CmmNode C O -> SDoc
pdoc = Platform -> Block CmmNode C O -> SDoc
forall (x :: Extensibility) (e :: Extensibility).
(IndexedCO x SDoc SDoc ~ SDoc) =>
Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance OutputableP Platform (Block CmmNode O C) where
pdoc :: Platform -> Block CmmNode O C -> SDoc
pdoc = Platform -> Block CmmNode O C -> SDoc
forall (x :: Extensibility) (e :: Extensibility).
(IndexedCO x SDoc SDoc ~ SDoc) =>
Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance OutputableP Platform (Block CmmNode O O) where
pdoc :: Platform -> Block CmmNode O O -> SDoc
pdoc = Platform -> Block CmmNode O O -> SDoc
forall (x :: Extensibility) (e :: Extensibility).
(IndexedCO x SDoc SDoc ~ SDoc) =>
Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance OutputableP Platform (Graph CmmNode e x) where
pdoc :: Platform -> Graph CmmNode e x -> SDoc
pdoc = Platform -> Graph CmmNode e x -> SDoc
forall (e :: Extensibility) (x :: Extensibility).
Platform -> Graph CmmNode e x -> SDoc
pprGraph
instance OutputableP Platform CmmGraph where
pdoc :: Platform -> CmmGraph -> SDoc
pdoc = Platform -> CmmGraph -> SDoc
pprCmmGraph
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo (StackInfo {arg_space :: CmmStackInfo -> ByteOff
arg_space=ByteOff
arg_space}) =
String -> SDoc
text String
"arg_space: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
arg_space
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
vcat [String -> SDoc
text String
"info_tbls: " SDoc -> SDoc -> SDoc
<> Platform -> LabelMap CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform LabelMap CmmInfoTable
info_tbl,
String -> SDoc
text String
"stack_info: " SDoc -> SDoc -> SDoc
<> CmmStackInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmStackInfo
stack_info]
pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
=> Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock :: forall (x :: Extensibility) (e :: Extensibility).
(IndexedCO x SDoc SDoc ~ SDoc) =>
Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock Platform
platform Block CmmNode e x
block
= (CmmNode C O -> SDoc -> SDoc, CmmNode O O -> SDoc -> SDoc,
CmmNode O C -> SDoc -> SDoc)
-> forall (e :: Extensibility) (x :: Extensibility).
Block CmmNode e x -> IndexedCO x SDoc SDoc -> IndexedCO e SDoc SDoc
forall (n :: Extensibility -> Extensibility -> *) a b c.
(n C O -> b -> c, n O O -> b -> b, n O C -> a -> b)
-> forall (e :: Extensibility) (x :: Extensibility).
Block n e x -> IndexedCO x a b -> IndexedCO e c b
foldBlockNodesB3 ( SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode C O -> SDoc) -> CmmNode C O -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmNode C O -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform
, SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode O O -> SDoc) -> CmmNode O O -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteOff -> SDoc -> SDoc
nest ByteOff
4) (SDoc -> SDoc) -> (CmmNode O O -> SDoc) -> CmmNode O O -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmNode O O -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform
, SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode O C -> SDoc) -> CmmNode O C -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteOff -> SDoc -> SDoc
nest ByteOff
4) (SDoc -> SDoc) -> (CmmNode O C -> SDoc) -> CmmNode O C -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmNode O C -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform
)
Block CmmNode e x
block
IndexedCO x SDoc SDoc
SDoc
empty
pprGraph :: Platform -> Graph CmmNode e x -> SDoc
pprGraph :: forall (e :: Extensibility) (x :: Extensibility).
Platform -> Graph CmmNode e x -> SDoc
pprGraph Platform
platform = \case
Graph CmmNode e x
GNil -> SDoc
empty
GUnit Block CmmNode O O
block -> Platform -> Block CmmNode O O -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Block CmmNode O O
block
GMany MaybeO e (Block CmmNode O C)
entry Body' Block CmmNode
body MaybeO x (Block CmmNode C O)
exit ->
String -> SDoc
text String
"{"
SDoc -> SDoc -> SDoc
$$ ByteOff -> SDoc -> SDoc
nest ByteOff
2 (MaybeO e (Block CmmNode O C) -> SDoc
forall (e :: Extensibility) (x :: Extensibility)
(ex :: Extensibility).
OutputableP Platform (Block CmmNode e x) =>
MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO MaybeO e (Block CmmNode O C)
entry SDoc -> SDoc -> SDoc
$$ ([SDoc] -> SDoc
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] -> [SDoc]) -> [CmmBlock] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ Body' Block CmmNode -> [CmmBlock]
bodyToBlockList Body' Block CmmNode
body) SDoc -> SDoc -> SDoc
$$ MaybeO x (Block CmmNode C O) -> SDoc
forall (e :: Extensibility) (x :: Extensibility)
(ex :: Extensibility).
OutputableP Platform (Block CmmNode e x) =>
MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO MaybeO x (Block CmmNode C O)
exit)
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"}"
where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
=> MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO :: forall (e :: Extensibility) (x :: Extensibility)
(ex :: Extensibility).
OutputableP Platform (Block CmmNode e x) =>
MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO MaybeO ex (Block CmmNode e x)
NothingO = SDoc
empty
pprMaybeO (JustO Block CmmNode e x
block) = Platform -> Block CmmNode e x -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Block CmmNode e x
block
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph Platform
platform CmmGraph
g
= String -> SDoc
text String
"{" SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"offset"
SDoc -> SDoc -> SDoc
$$ ByteOff -> SDoc -> SDoc
nest ByteOff
2 ([SDoc] -> SDoc
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
$$ String -> SDoc
text String
"}"
where blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g
pprConvention :: Convention -> SDoc
pprConvention :: Convention -> SDoc
pprConvention (NativeNodeCall {}) = String -> SDoc
text String
"<native-node-call-convention>"
pprConvention (NativeDirectCall {}) = String -> SDoc
text String
"<native-direct-call-convention>"
pprConvention (NativeReturn {}) = String -> SDoc
text String
"<native-ret-convention>"
pprConvention Convention
Slow = String -> SDoc
text String
"<slow-convention>"
pprConvention Convention
GC = String -> SDoc
text String
"<gc-convention>"
pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention (ForeignConvention CCallConv
c [ForeignHint]
args [ForeignHint]
res CmmReturnInfo
ret) =
SDoc -> SDoc
doubleQuotes (CCallConv -> SDoc
forall a. Outputable a => a -> SDoc
ppr CCallConv
c) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"arg hints: " SDoc -> SDoc -> SDoc
<+> [ForeignHint] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ForeignHint]
args SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" result hints: " SDoc -> SDoc -> SDoc
<+> [ForeignHint] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ForeignHint]
res SDoc -> SDoc -> SDoc
<+> CmmReturnInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReturnInfo
ret
pprReturnInfo :: CmmReturnInfo -> SDoc
pprReturnInfo :: CmmReturnInfo -> SDoc
pprReturnInfo CmmReturnInfo
CmmMayReturn = SDoc
empty
pprReturnInfo CmmReturnInfo
CmmNeverReturns = String -> SDoc
text String
"never returns"
pprForeignTarget :: Platform -> ForeignTarget -> SDoc
pprForeignTarget :: Platform -> ForeignTarget -> SDoc
pprForeignTarget Platform
platform (ForeignTarget CmmExpr
fn ForeignConvention
c) = ForeignConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignConvention
c SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
ppr_target CmmExpr
fn
where
ppr_target :: CmmExpr -> SDoc
ppr_target :: CmmExpr -> SDoc
ppr_target t :: CmmExpr
t@(CmmLit CmmLit
_) = Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
t
ppr_target CmmExpr
fn' = SDoc -> SDoc
parens (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
fn')
pprForeignTarget Platform
platform (PrimTarget CallishMachOp
op)
= Platform -> CmmLit -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform
(CLabel -> CmmLit
CmmLabel (FastString
-> Maybe ByteOff -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel
(String -> FastString
mkFastString (CallishMachOp -> String
forall a. Show a => a -> String
show CallishMachOp
op))
Maybe ByteOff
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction))
pprNode :: Platform -> CmmNode e x -> SDoc
pprNode :: forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> SDoc
pprNode Platform
platform CmmNode e x
node = SDoc
pp_node SDoc -> SDoc -> SDoc
<+> SDoc
pp_debug
where
pp_node :: SDoc
pp_node :: SDoc
pp_node = case CmmNode e x
node of
CmmEntry Label
id CmmTickScope
tscope ->
((SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressUniques ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> String -> SDoc
text String
"_lbl_"
Bool
False -> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
id
)
SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<+> (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressTicks (String -> SDoc
text String
"//" SDoc -> SDoc -> SDoc
<+> CmmTickScope -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmTickScope
tscope)
CmmComment FastString
s -> String -> SDoc
text String
"//" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext FastString
s
CmmTick CmmTickish
t -> (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressTicks
(String -> SDoc
text String
"//tick" SDoc -> SDoc -> SDoc
<+> CmmTickish -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmTickish
t)
CmmUnwind [(GlobalReg, Maybe CmmExpr)]
regs ->
String -> SDoc
text String
"unwind "
SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
commafy (((GlobalReg, Maybe CmmExpr) -> SDoc)
-> [(GlobalReg, Maybe CmmExpr)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(GlobalReg
r,Maybe CmmExpr
e) -> GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalReg
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'=' SDoc -> SDoc -> SDoc
<+> Platform -> Maybe CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe CmmExpr
e) [(GlobalReg, Maybe CmmExpr)]
regs) SDoc -> SDoc -> SDoc
<> SDoc
semi
CmmAssign CmmReg
reg CmmExpr
expr -> CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr SDoc -> SDoc -> SDoc
<> SDoc
semi
CmmStore CmmExpr
lv CmmExpr
expr -> SDoc
rep SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
lv) SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr SDoc -> SDoc -> SDoc
<> SDoc
semi
where
rep :: SDoc
rep = CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr ( Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
expr )
CmmUnsafeForeignCall ForeignTarget
target [CmmFormal]
results [CmmExpr]
args ->
[SDoc] -> SDoc
hsep [ Bool -> SDoc -> SDoc
ppUnless ([CmmFormal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CmmFormal]
results) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
parens ([SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmFormal -> SDoc) -> [CmmFormal] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmFormal -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmFormal]
results) SDoc -> SDoc -> SDoc
<+> SDoc
equals,
String -> SDoc
text String
"call",
Platform -> ForeignTarget -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform ForeignTarget
target SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens ([SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform) [CmmExpr]
args) SDoc -> SDoc -> SDoc
<> SDoc
semi]
CmmBranch Label
ident -> String -> SDoc
text String
"goto" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
ident SDoc -> SDoc -> SDoc
<> SDoc
semi
CmmCondBranch CmmExpr
expr Label
t Label
f Maybe Bool
l ->
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"if"
, SDoc -> SDoc
parens (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
, case Maybe Bool
l of
Maybe Bool
Nothing -> SDoc
empty
Just Bool
b -> SDoc -> SDoc
parens (String -> SDoc
text String
"likely:" SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
b)
, String -> SDoc
text String
"goto"
, Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
t SDoc -> SDoc -> SDoc
<> SDoc
semi
, String -> SDoc
text String
"else goto"
, Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
f SDoc -> SDoc -> SDoc
<> SDoc
semi
]
CmmSwitch CmmExpr
expr SwitchTargets
ids ->
SDoc -> ByteOff -> SDoc -> SDoc
hang ([SDoc] -> SDoc
hsep [ String -> SDoc
text String
"switch"
, SDoc
range
, if CmmExpr -> Bool
isTrivialCmmExpr CmmExpr
expr
then Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr
else SDoc -> SDoc
parens (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
, String -> SDoc
text String
"{"
])
ByteOff
4 ([SDoc] -> SDoc
vcat ((([Integer], Label) -> SDoc) -> [([Integer], Label)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer], Label) -> SDoc
forall {a}. Outputable a => ([Integer], a) -> SDoc
ppCase [([Integer], Label)]
cases) SDoc -> SDoc -> SDoc
$$ SDoc
def) SDoc -> SDoc -> SDoc
$$ SDoc
rbrace
where
([([Integer], Label)]
cases, Maybe Label
mbdef) = SwitchTargets -> ([([Integer], Label)], Maybe Label)
switchTargetsFallThrough SwitchTargets
ids
ppCase :: ([Integer], a) -> SDoc
ppCase ([Integer]
is,a
l) = [SDoc] -> SDoc
hsep
[ String -> SDoc
text String
"case"
, [SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Integer -> SDoc) -> [Integer] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SDoc
integer [Integer]
is
, String -> SDoc
text String
": goto"
, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
l SDoc -> SDoc -> SDoc
<> SDoc
semi
]
def :: SDoc
def | Just Label
l <- Maybe Label
mbdef = [SDoc] -> SDoc
hsep
[ String -> SDoc
text String
"default:"
, SDoc -> SDoc
braces (String -> SDoc
text String
"goto" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l SDoc -> SDoc -> SDoc
<> SDoc
semi)
]
| Bool
otherwise = SDoc
empty
range :: SDoc
range = SDoc -> SDoc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [Integer -> SDoc
integer Integer
lo, String -> SDoc
text String
"..", Integer -> SDoc
integer Integer
hi]
where (Integer
lo,Integer
hi) = SwitchTargets -> (Integer, Integer)
switchTargetsRange SwitchTargets
ids
CmmCall CmmExpr
tgt Maybe Label
k [GlobalReg]
regs ByteOff
out ByteOff
res ByteOff
updfr_off ->
[SDoc] -> SDoc
hcat [ String -> SDoc
text String
"call", SDoc
space
, CmmExpr -> SDoc
pprFun CmmExpr
tgt, SDoc -> SDoc
parens ([GlobalReg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [GlobalReg]
regs), SDoc
space
, SDoc
returns SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"args: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
out SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"res: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
res SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"upd: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
updfr_off
, SDoc
semi ]
where pprFun :: CmmExpr -> SDoc
pprFun f :: CmmExpr
f@(CmmLit CmmLit
_) = Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
f
pprFun CmmExpr
f = SDoc -> SDoc
parens (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
f)
returns :: SDoc
returns
| Just Label
r <- Maybe Label
k = String -> SDoc
text String
"returns to" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
r SDoc -> SDoc -> SDoc
<> SDoc
comma
| Bool
otherwise = SDoc
empty
CmmForeignCall {tgt :: CmmNode O C -> ForeignTarget
tgt=ForeignTarget
t, res :: CmmNode O C -> [CmmFormal]
res=[CmmFormal]
rs, args :: CmmNode O C -> [CmmExpr]
args=[CmmExpr]
as, succ :: CmmNode O C -> Label
succ=Label
s, ret_args :: CmmNode O C -> ByteOff
ret_args=ByteOff
a, ret_off :: CmmNode O C -> ByteOff
ret_off=ByteOff
u, intrbl :: CmmNode O C -> Bool
intrbl=Bool
i} ->
[SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ if Bool
i then [String -> SDoc
text String
"interruptible", SDoc
space] else [] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
[ String -> SDoc
text String
"foreign call", SDoc
space
, Platform -> ForeignTarget -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform ForeignTarget
t, String -> SDoc
text String
"(...)", SDoc
space
, String -> SDoc
text String
"returns to" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
s
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"args:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (Platform -> [CmmExpr] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CmmExpr]
as)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"ress:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([CmmFormal] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmFormal]
rs)
, String -> SDoc
text String
"ret_args:" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
a
, String -> SDoc
text String
"ret_off:" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
u
, SDoc
semi ]
pp_debug :: SDoc
pp_debug :: SDoc
pp_debug =
if Bool -> Bool
not Bool
debugIsOn then SDoc
empty
else case CmmNode e x
node of
CmmEntry {} -> SDoc
empty
CmmComment {} -> SDoc
empty
CmmTick {} -> SDoc
empty
CmmUnwind {} -> String -> SDoc
text String
" // CmmUnwind"
CmmAssign {} -> String -> SDoc
text String
" // CmmAssign"
CmmStore {} -> String -> SDoc
text String
" // CmmStore"
CmmUnsafeForeignCall {} -> String -> SDoc
text String
" // CmmUnsafeForeignCall"
CmmBranch {} -> String -> SDoc
text String
" // CmmBranch"
CmmCondBranch {} -> String -> SDoc
text String
" // CmmCondBranch"
CmmSwitch {} -> String -> SDoc
text String
" // CmmSwitch"
CmmCall {} -> String -> SDoc
text String
" // CmmCall"
CmmForeignCall {} -> String -> SDoc
text String
" // CmmForeignCall"
commafy :: [SDoc] -> SDoc
commafy :: [SDoc] -> SDoc
commafy [SDoc]
xs = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
xs