{-# LANGUAGE LambdaCase #-}
module GHC.Llvm.Ppr (
ppLlvmModule,
ppLlvmComments,
ppLlvmComment,
ppLlvmGlobals,
ppLlvmGlobal,
ppLlvmAliases,
ppLlvmAlias,
ppLlvmMetas,
ppLlvmMeta,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
ppLlvmFunction,
ppVar,
ppLit,
ppTypeLit,
ppName,
ppPlainName
) where
import GHC.Prelude
import GHC.Llvm.Syntax
import GHC.Llvm.MetaData
import GHC.Llvm.Types
import Data.Int
import Data.List ( intersperse )
import GHC.Utils.Outputable
import GHC.CmmToLlvm.Config
import GHC.Utils.Panic
import GHC.Types.Unique
ppLlvmModule :: LlvmCgConfig -> LlvmModule -> SDoc
ppLlvmModule :: LlvmCgConfig -> LlvmModule -> SDoc
ppLlvmModule LlvmCgConfig
opts (LlvmModule [LMString]
comments [LlvmAlias]
aliases [MetaDecl]
meta [LMGlobal]
globals LlvmFunctionDecls
decls LlvmFunctions
funcs)
= [LMString] -> SDoc
ppLlvmComments [LMString]
comments SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ [LlvmAlias] -> SDoc
ppLlvmAliases [LlvmAlias]
aliases SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmCgConfig -> [MetaDecl] -> SDoc
ppLlvmMetas LlvmCgConfig
opts [MetaDecl]
meta SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmCgConfig -> [LMGlobal] -> SDoc
ppLlvmGlobals LlvmCgConfig
opts [LMGlobal]
globals SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls LlvmFunctionDecls
decls SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmCgConfig -> LlvmFunctions -> SDoc
ppLlvmFunctions LlvmCgConfig
opts LlvmFunctions
funcs
ppLlvmComments :: [LMString] -> SDoc
[LMString]
comments = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LMString -> SDoc
ppLlvmComment [LMString]
comments
ppLlvmComment :: LMString -> SDoc
LMString
com = forall doc. IsLine doc => doc
semi forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => LMString -> doc
ftext LMString
com
ppLlvmGlobals :: LlvmCgConfig -> [LMGlobal] -> SDoc
ppLlvmGlobals :: LlvmCgConfig -> [LMGlobal] -> SDoc
ppLlvmGlobals LlvmCgConfig
opts [LMGlobal]
ls = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LMGlobal -> SDoc
ppLlvmGlobal LlvmCgConfig
opts) [LMGlobal]
ls
ppLlvmGlobal :: LlvmCgConfig -> LMGlobal -> SDoc
ppLlvmGlobal :: LlvmCgConfig -> LMGlobal -> SDoc
ppLlvmGlobal LlvmCgConfig
opts (LMGlobal var :: LlvmVar
var@(LMGlobalVar LMString
_ LlvmType
_ LlvmLinkageType
link LMSection
x LMAlign
a LMConst
c) Maybe LlvmStatic
dat) =
let sect :: SDoc
sect = case LMSection
x of
Just LMString
x' -> forall doc. IsLine doc => String -> doc
text String
", section" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
doubleQuotes (forall doc. IsLine doc => LMString -> doc
ftext LMString
x')
LMSection
Nothing -> forall doc. IsOutput doc => doc
empty
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> forall doc. IsLine doc => String -> doc
text String
", align" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
a'
LMAlign
Nothing -> forall doc. IsOutput doc => doc
empty
rhs :: SDoc
rhs = case Maybe LlvmStatic
dat of
Just LlvmStatic
stat -> LlvmCgConfig -> LlvmStatic -> SDoc
pprSpecialStatic LlvmCgConfig
opts LlvmStatic
stat
Maybe LlvmStatic
Nothing -> forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var)
const :: String
const = case LMConst
c of
LMConst
Global -> String
"global"
LMConst
Constant -> String
"constant"
LMConst
Alias -> String
"alias"
in LlvmCgConfig -> LlvmVar -> SDoc -> SDoc
ppAssignment LlvmCgConfig
opts LlvmVar
var forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
link forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
const forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
rhs forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
sect forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
ppLlvmGlobal LlvmCgConfig
opts (LMGlobal LlvmVar
var Maybe LlvmStatic
val) = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ppLlvmGlobal" forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => String -> doc
text String
"Non Global var ppr as global! " forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
var forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"=" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts) Maybe LlvmStatic
val)
ppLlvmAliases :: [LlvmAlias] -> SDoc
ppLlvmAliases :: [LlvmAlias] -> SDoc
ppLlvmAliases [LlvmAlias]
tys = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LlvmAlias -> SDoc
ppLlvmAlias [LlvmAlias]
tys
ppLlvmAlias :: LlvmAlias -> SDoc
ppLlvmAlias :: LlvmAlias -> SDoc
ppLlvmAlias (LMString
name, LlvmType
ty)
= forall doc. IsLine doc => Char -> doc
char Char
'%' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
name forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"type" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
ty
ppLlvmMetas :: LlvmCgConfig -> [MetaDecl] -> SDoc
ppLlvmMetas :: LlvmCgConfig -> [MetaDecl] -> SDoc
ppLlvmMetas LlvmCgConfig
opts [MetaDecl]
metas = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> MetaDecl -> SDoc
ppLlvmMeta LlvmCgConfig
opts) [MetaDecl]
metas
ppLlvmMeta :: LlvmCgConfig -> MetaDecl -> SDoc
ppLlvmMeta :: LlvmCgConfig -> MetaDecl -> SDoc
ppLlvmMeta LlvmCgConfig
opts (MetaUnnamed MetaId
n MetaExpr
m)
= forall a. Outputable a => a -> SDoc
ppr MetaId
n forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts MetaExpr
m
ppLlvmMeta LlvmCgConfig
_opts (MetaNamed LMString
n [MetaId]
m)
= SDoc
exclamation forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
n forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
exclamation forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces SDoc
nodes
where
nodes :: SDoc
nodes = forall doc. IsLine doc => [doc] -> doc
hcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse forall doc. IsLine doc => doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [MetaId]
m
ppLlvmFunctions :: LlvmCgConfig -> LlvmFunctions -> SDoc
ppLlvmFunctions :: LlvmCgConfig -> LlvmFunctions -> SDoc
ppLlvmFunctions LlvmCgConfig
opts LlvmFunctions
funcs = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmFunction -> SDoc
ppLlvmFunction LlvmCgConfig
opts) LlvmFunctions
funcs
ppLlvmFunction :: LlvmCgConfig -> LlvmFunction -> SDoc
ppLlvmFunction :: LlvmCgConfig -> LlvmFunction -> SDoc
ppLlvmFunction LlvmCgConfig
opts LlvmFunction
fun =
let attrDoc :: SDoc
attrDoc = forall a. Outputable a => [a] -> SDoc
ppSpaceJoin (LlvmFunction -> [LlvmFuncAttr]
funcAttrs LlvmFunction
fun)
secDoc :: SDoc
secDoc = case LlvmFunction -> LMSection
funcSect LlvmFunction
fun of
Just LMString
s' -> forall doc. IsLine doc => String -> doc
text String
"section" forall doc. IsLine doc => doc -> doc -> doc
<+> (forall doc. IsLine doc => doc -> doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => LMString -> doc
ftext LMString
s')
LMSection
Nothing -> forall doc. IsOutput doc => doc
empty
prefixDoc :: SDoc
prefixDoc = case LlvmFunction -> Maybe LlvmStatic
funcPrefix LlvmFunction
fun of
Just LlvmStatic
v -> forall doc. IsLine doc => String -> doc
text String
"prefix" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
v
Maybe LlvmStatic
Nothing -> forall doc. IsOutput doc => doc
empty
in forall doc. IsLine doc => String -> doc
text String
"define" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmFunctionDecl -> [LMString] -> SDoc
ppLlvmFunctionHeader (LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun) (LlvmFunction -> [LMString]
funcArgs LlvmFunction
fun)
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
attrDoc forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
secDoc forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
prefixDoc
SDoc -> SDoc -> SDoc
$+$ forall doc. IsLine doc => doc
lbrace
SDoc -> SDoc -> SDoc
$+$ LlvmCgConfig -> LlvmBlocks -> SDoc
ppLlvmBlocks LlvmCgConfig
opts (LlvmFunction -> LlvmBlocks
funcBody LlvmFunction
fun)
SDoc -> SDoc -> SDoc
$+$ forall doc. IsLine doc => doc
rbrace
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc
(LlvmFunctionDecl LMString
n LlvmLinkageType
l LlvmCallConvention
c LlvmType
r LlvmParameterListType
varg [LlvmParameter]
p LMAlign
a) [LMString]
args
= let varg' :: SDoc
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmParameter]
p -> forall doc. IsLine doc => String -> doc
text String
"..."
| Bool
otherwise -> forall doc. IsLine doc => String -> doc
text String
", ..."
LlvmParameterListType
_otherwise -> forall doc. IsLine doc => String -> doc
text String
""
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> forall doc. IsLine doc => String -> doc
text String
" align " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> forall doc. IsOutput doc => doc
empty
args' :: [SDoc]
args' = forall a b. (a -> b) -> [a] -> [b]
map (\((LlvmType
ty,[LlvmParamAttr]
p),LMString
n) -> forall a. Outputable a => a -> SDoc
ppr LlvmType
ty forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
p forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'%'
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
n)
(forall a b. [a] -> [b] -> [(a, b)]
zip [LlvmParameter]
p [LMString]
args)
in forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
r forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<>
(forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma [SDoc]
args') forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
varg' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
rparen forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align
ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls LlvmFunctionDecls
decs = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LlvmFunctionDecl -> SDoc
ppLlvmFunctionDecl LlvmFunctionDecls
decs
ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc
ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc
ppLlvmFunctionDecl (LlvmFunctionDecl LMString
n LlvmLinkageType
l LlvmCallConvention
c LlvmType
r LlvmParameterListType
varg [LlvmParameter]
p LMAlign
a)
= let varg' :: SDoc
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmParameter]
p -> forall doc. IsLine doc => String -> doc
text String
"..."
| Bool
otherwise -> forall doc. IsLine doc => String -> doc
text String
", ..."
LlvmParameterListType
_otherwise -> forall doc. IsLine doc => String -> doc
text String
""
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> forall doc. IsLine doc => String -> doc
text String
" align" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> forall doc. IsOutput doc => doc
empty
args :: SDoc
args = forall doc. IsLine doc => [doc] -> doc
hcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
space) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(LlvmType
t,[LlvmParamAttr]
a) -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
a) [LlvmParameter]
p
in forall doc. IsLine doc => String -> doc
text String
"declare" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
r forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<>
forall doc. IsLine doc => LMString -> doc
ftext LMString
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
args forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
varg' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
rparen forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
ppLlvmBlocks :: LlvmCgConfig -> LlvmBlocks -> SDoc
ppLlvmBlocks :: LlvmCgConfig -> LlvmBlocks -> SDoc
ppLlvmBlocks LlvmCgConfig
opts LlvmBlocks
blocks = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmBlock -> SDoc
ppLlvmBlock LlvmCgConfig
opts) LlvmBlocks
blocks
ppLlvmBlock :: LlvmCgConfig -> LlvmBlock -> SDoc
ppLlvmBlock :: LlvmCgConfig -> LlvmBlock -> SDoc
ppLlvmBlock LlvmCgConfig
opts (LlvmBlock LlvmBlockId
blockId [LlvmStatement]
stmts) =
let isLabel :: LlvmStatement -> Bool
isLabel (MkLabel LlvmBlockId
_) = Bool
True
isLabel LlvmStatement
_ = Bool
False
([LlvmStatement]
block, [LlvmStatement]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break LlvmStatement -> Bool
isLabel [LlvmStatement]
stmts
ppRest :: SDoc
ppRest = case [LlvmStatement]
rest of
MkLabel LlvmBlockId
id:[LlvmStatement]
xs -> LlvmCgConfig -> LlvmBlock -> SDoc
ppLlvmBlock LlvmCgConfig
opts (LlvmBlockId -> [LlvmStatement] -> LlvmBlock
LlvmBlock LlvmBlockId
id [LlvmStatement]
xs)
[LlvmStatement]
_ -> forall doc. IsOutput doc => doc
empty
in LlvmBlockId -> SDoc
ppLlvmBlockLabel LlvmBlockId
blockId
SDoc -> SDoc -> SDoc
$+$ (forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmStatement -> SDoc
ppLlvmStatement LlvmCgConfig
opts) [LlvmStatement]
block)
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ SDoc
ppRest
ppLlvmBlockLabel :: LlvmBlockId -> SDoc
ppLlvmBlockLabel :: LlvmBlockId -> SDoc
ppLlvmBlockLabel LlvmBlockId
id = forall doc. IsLine doc => LlvmBlockId -> doc
pprUniqueAlways LlvmBlockId
id forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
ppLlvmStatement :: LlvmCgConfig -> LlvmStatement -> SDoc
ppLlvmStatement :: LlvmCgConfig -> LlvmStatement -> SDoc
ppLlvmStatement LlvmCgConfig
opts LlvmStatement
stmt =
let ind :: SDoc -> SDoc
ind = (forall doc. IsLine doc => String -> doc
text String
" " forall doc. IsLine doc => doc -> doc -> doc
<>)
in case LlvmStatement
stmt of
Assignment LlvmVar
dst LlvmExpression
expr -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> SDoc -> SDoc
ppAssignment LlvmCgConfig
opts LlvmVar
dst (LlvmCgConfig -> LlvmExpression -> SDoc
ppLlvmExpression LlvmCgConfig
opts LlvmExpression
expr)
Fence Bool
st LlvmSyncOrdering
ord -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ Bool -> LlvmSyncOrdering -> SDoc
ppFence Bool
st LlvmSyncOrdering
ord
Branch LlvmVar
target -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> SDoc
ppBranch LlvmCgConfig
opts LlvmVar
target
BranchIf LlvmVar
cond LlvmVar
ifT LlvmVar
ifF -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf LlvmCgConfig
opts LlvmVar
cond LlvmVar
ifT LlvmVar
ifF
Comment [LMString]
comments -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ [LMString] -> SDoc
ppLlvmComments [LMString]
comments
MkLabel LlvmBlockId
label -> LlvmBlockId -> SDoc
ppLlvmBlockLabel LlvmBlockId
label
Store LlvmVar
value LlvmVar
ptr LMAlign
align
-> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> SDoc
ppStore LlvmCgConfig
opts LlvmVar
value LlvmVar
ptr LMAlign
align
Switch LlvmVar
scrut LlvmVar
def [(LlvmVar, LlvmVar)]
tgs -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar, LlvmVar)] -> SDoc
ppSwitch LlvmCgConfig
opts LlvmVar
scrut LlvmVar
def [(LlvmVar, LlvmVar)]
tgs
Return Maybe LlvmVar
result -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> Maybe LlvmVar -> SDoc
ppReturn LlvmCgConfig
opts Maybe LlvmVar
result
Expr LlvmExpression
expr -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmExpression -> SDoc
ppLlvmExpression LlvmCgConfig
opts LlvmExpression
expr
LlvmStatement
Unreachable -> SDoc -> SDoc
ind forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"unreachable"
LlvmStatement
Nop -> forall doc. IsOutput doc => doc
empty
MetaStmt [MetaAnnot]
meta LlvmStatement
s -> LlvmCgConfig -> [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement LlvmCgConfig
opts [MetaAnnot]
meta LlvmStatement
s
ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc
ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc
ppLlvmExpression LlvmCgConfig
opts LlvmExpression
expr
= case LlvmExpression
expr of
Alloca LlvmType
tp Int
amount -> LlvmCgConfig -> LlvmType -> Int -> SDoc
ppAlloca LlvmCgConfig
opts LlvmType
tp Int
amount
LlvmOp LlvmMachOp
op LlvmVar
left LlvmVar
right -> LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp LlvmCgConfig
opts LlvmMachOp
op LlvmVar
left LlvmVar
right
Call LlvmCallType
tp LlvmVar
fp [LlvmVar]
args [LlvmFuncAttr]
attrs -> LlvmCgConfig
-> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall LlvmCgConfig
opts LlvmCallType
tp LlvmVar
fp (forall a b. (a -> b) -> [a] -> [b]
map LlvmVar -> MetaExpr
MetaVar [LlvmVar]
args) [LlvmFuncAttr]
attrs
CallM LlvmCallType
tp LlvmVar
fp [MetaExpr]
args [LlvmFuncAttr]
attrs -> LlvmCgConfig
-> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall LlvmCgConfig
opts LlvmCallType
tp LlvmVar
fp [MetaExpr]
args [LlvmFuncAttr]
attrs
Cast LlvmCastOp
op LlvmVar
from LlvmType
to -> LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast LlvmCgConfig
opts LlvmCastOp
op LlvmVar
from LlvmType
to
Compare LlvmCmpOp
op LlvmVar
left LlvmVar
right -> LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp LlvmCgConfig
opts LlvmCmpOp
op LlvmVar
left LlvmVar
right
Extract LlvmVar
vec LlvmVar
idx -> LlvmCgConfig -> LlvmVar -> LlvmVar -> SDoc
ppExtract LlvmCgConfig
opts LlvmVar
vec LlvmVar
idx
ExtractV LlvmVar
struct Int
idx -> LlvmCgConfig -> LlvmVar -> Int -> SDoc
ppExtractV LlvmCgConfig
opts LlvmVar
struct Int
idx
Insert LlvmVar
vec LlvmVar
elt LlvmVar
idx -> LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert LlvmCgConfig
opts LlvmVar
vec LlvmVar
elt LlvmVar
idx
GetElemPtr Bool
inb LlvmVar
ptr [LlvmVar]
indexes -> LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr LlvmCgConfig
opts Bool
inb LlvmVar
ptr [LlvmVar]
indexes
Load LlvmVar
ptr LMAlign
align -> LlvmCgConfig -> LlvmVar -> LMAlign -> SDoc
ppLoad LlvmCgConfig
opts LlvmVar
ptr LMAlign
align
ALoad LlvmSyncOrdering
ord Bool
st LlvmVar
ptr -> LlvmCgConfig -> LlvmSyncOrdering -> Bool -> LlvmVar -> SDoc
ppALoad LlvmCgConfig
opts LlvmSyncOrdering
ord Bool
st LlvmVar
ptr
Malloc LlvmType
tp Int
amount -> LlvmCgConfig -> LlvmType -> Int -> SDoc
ppMalloc LlvmCgConfig
opts LlvmType
tp Int
amount
AtomicRMW LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering -> LlvmCgConfig
-> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW LlvmCgConfig
opts LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering
CmpXChg LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord -> LlvmCgConfig
-> LlvmVar
-> LlvmVar
-> LlvmVar
-> LlvmSyncOrdering
-> LlvmSyncOrdering
-> SDoc
ppCmpXChg LlvmCgConfig
opts LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord
Phi LlvmType
tp [(LlvmVar, LlvmVar)]
predecessors -> LlvmCgConfig -> LlvmType -> [(LlvmVar, LlvmVar)] -> SDoc
ppPhi LlvmCgConfig
opts LlvmType
tp [(LlvmVar, LlvmVar)]
predecessors
Asm LMString
asm LMString
c LlvmType
ty [LlvmVar]
v Bool
se Bool
sk -> LlvmCgConfig
-> LMString
-> LMString
-> LlvmType
-> [LlvmVar]
-> Bool
-> Bool
-> SDoc
ppAsm LlvmCgConfig
opts LMString
asm LMString
c LlvmType
ty [LlvmVar]
v Bool
se Bool
sk
MExpr [MetaAnnot]
meta LlvmExpression
expr -> LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaAnnotExpr LlvmCgConfig
opts [MetaAnnot]
meta LlvmExpression
expr
ppMetaExpr :: LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr :: LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts = \case
MetaVar (LMLitVar (LMNullLit LlvmType
_)) -> forall doc. IsLine doc => String -> doc
text String
"null"
MetaStr LMString
s -> forall doc. IsLine doc => Char -> doc
char Char
'!' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
doubleQuotes (forall doc. IsLine doc => LMString -> doc
ftext LMString
s)
MetaNode MetaId
n -> forall a. Outputable a => a -> SDoc
ppr MetaId
n
MetaVar LlvmVar
v -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
v
MetaStruct [MetaExpr]
es -> forall doc. IsLine doc => Char -> doc
char Char
'!' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts) [MetaExpr]
es))
ppCall :: LlvmCgConfig -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall :: LlvmCgConfig
-> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall LlvmCgConfig
opts LlvmCallType
ct LlvmVar
fptr [MetaExpr]
args [LlvmFuncAttr]
attrs = case LlvmVar
fptr of
LMLocalVar LlvmBlockId
_ (LMPointer (LMFunction LlvmFunctionDecl
d)) -> LlvmFunctionDecl -> SDoc
ppCall' LlvmFunctionDecl
d
LMGlobalVar LMString
_ (LMFunction LlvmFunctionDecl
d) LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_ -> LlvmFunctionDecl -> SDoc
ppCall' LlvmFunctionDecl
d
LlvmVar
_other -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"ppCall called with non LMFunction type!\nMust be "
forall a. [a] -> [a] -> [a]
++ String
" called with either global var of function type or "
forall a. [a] -> [a] -> [a]
++ String
"local var of pointer function type."
where
ppCall' :: LlvmFunctionDecl -> SDoc
ppCall' (LlvmFunctionDecl LMString
_ LlvmLinkageType
_ LlvmCallConvention
cc LlvmType
ret LlvmParameterListType
argTy [LlvmParameter]
params LMAlign
_) =
let tc :: SDoc
tc = if LlvmCallType
ct forall a. Eq a => a -> a -> Bool
== LlvmCallType
TailCall then forall doc. IsLine doc => String -> doc
text String
"tail " else forall doc. IsOutput doc => doc
empty
ppValues :: SDoc
ppValues = LlvmCgConfig -> [[LlvmParamAttr]] -> [MetaExpr] -> SDoc
ppCallParams LlvmCgConfig
opts (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [LlvmParameter]
params) [MetaExpr]
args
ppArgTy :: SDoc
ppArgTy = (forall a. Outputable a => [a] -> SDoc
ppCommaJoin forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [LlvmParameter]
params) forall doc. IsLine doc => doc -> doc -> doc
<>
(case LlvmParameterListType
argTy of
LlvmParameterListType
VarArgs -> forall doc. IsLine doc => String -> doc
text String
", ..."
LlvmParameterListType
FixedArgs -> forall doc. IsOutput doc => doc
empty)
fnty :: SDoc
fnty = forall doc. IsLine doc => doc
space forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ppArgTy forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
rparen
attrDoc :: SDoc
attrDoc = forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmFuncAttr]
attrs
in SDoc
tc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"call" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
cc forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
ret
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
fnty forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
fptr forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppValues
forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
rparen forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
attrDoc
ppCallParams :: LlvmCgConfig -> [[LlvmParamAttr]] -> [MetaExpr] -> SDoc
ppCallParams :: LlvmCgConfig -> [[LlvmParamAttr]] -> [MetaExpr] -> SDoc
ppCallParams LlvmCgConfig
opts [[LlvmParamAttr]]
attrs [MetaExpr]
args = forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [LlvmParamAttr] -> MetaExpr -> SDoc
ppCallMetaExpr [[LlvmParamAttr]]
attrs [MetaExpr]
args
where
ppCallMetaExpr :: [LlvmParamAttr] -> MetaExpr -> SDoc
ppCallMetaExpr [LlvmParamAttr]
attrs (MetaVar LlvmVar
v) = [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar' [LlvmParamAttr]
attrs LlvmCgConfig
opts LlvmVar
v
ppCallMetaExpr [LlvmParamAttr]
_ MetaExpr
v = forall doc. IsLine doc => String -> doc
text String
"metadata" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts MetaExpr
v
ppMachOp :: LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp :: LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp LlvmCgConfig
opts LlvmMachOp
op LlvmVar
left LlvmVar
right =
(forall a. Outputable a => a -> SDoc
ppr LlvmMachOp
op) forall doc. IsLine doc => doc -> doc -> doc
<+> (forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
left)) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
left
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
right
ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp LlvmCgConfig
opts LlvmCmpOp
op LlvmVar
left LlvmVar
right =
let cmpOp :: SDoc
cmpOp
| LlvmType -> Bool
isInt (LlvmVar -> LlvmType
getVarType LlvmVar
left) Bool -> Bool -> Bool
&& LlvmType -> Bool
isInt (LlvmVar -> LlvmType
getVarType LlvmVar
right) = forall doc. IsLine doc => String -> doc
text String
"icmp"
| LlvmType -> Bool
isFloat (LlvmVar -> LlvmType
getVarType LlvmVar
left) Bool -> Bool -> Bool
&& LlvmType -> Bool
isFloat (LlvmVar -> LlvmType
getVarType LlvmVar
right) = forall doc. IsLine doc => String -> doc
text String
"fcmp"
| Bool
otherwise = forall doc. IsLine doc => String -> doc
text String
"icmp"
in SDoc
cmpOp forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmCmpOp
op forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
left)
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
left forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
right
ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc
ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc
ppAssignment LlvmCgConfig
opts LlvmVar
var SDoc
expr = LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
var forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
expr
ppFence :: Bool -> LlvmSyncOrdering -> SDoc
ppFence :: Bool -> LlvmSyncOrdering -> SDoc
ppFence Bool
st LlvmSyncOrdering
ord =
let singleThread :: SDoc
singleThread = case Bool
st of Bool
True -> forall doc. IsLine doc => String -> doc
text String
"singlethread"
Bool
False -> forall doc. IsOutput doc => doc
empty
in forall doc. IsLine doc => String -> doc
text String
"fence" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
singleThread forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ord
ppSyncOrdering :: LlvmSyncOrdering -> SDoc
ppSyncOrdering :: LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
SyncUnord = forall doc. IsLine doc => String -> doc
text String
"unordered"
ppSyncOrdering LlvmSyncOrdering
SyncMonotonic = forall doc. IsLine doc => String -> doc
text String
"monotonic"
ppSyncOrdering LlvmSyncOrdering
SyncAcquire = forall doc. IsLine doc => String -> doc
text String
"acquire"
ppSyncOrdering LlvmSyncOrdering
SyncRelease = forall doc. IsLine doc => String -> doc
text String
"release"
ppSyncOrdering LlvmSyncOrdering
SyncAcqRel = forall doc. IsLine doc => String -> doc
text String
"acq_rel"
ppSyncOrdering LlvmSyncOrdering
SyncSeqCst = forall doc. IsLine doc => String -> doc
text String
"seq_cst"
ppAtomicOp :: LlvmAtomicOp -> SDoc
ppAtomicOp :: LlvmAtomicOp -> SDoc
ppAtomicOp LlvmAtomicOp
LAO_Xchg = forall doc. IsLine doc => String -> doc
text String
"xchg"
ppAtomicOp LlvmAtomicOp
LAO_Add = forall doc. IsLine doc => String -> doc
text String
"add"
ppAtomicOp LlvmAtomicOp
LAO_Sub = forall doc. IsLine doc => String -> doc
text String
"sub"
ppAtomicOp LlvmAtomicOp
LAO_And = forall doc. IsLine doc => String -> doc
text String
"and"
ppAtomicOp LlvmAtomicOp
LAO_Nand = forall doc. IsLine doc => String -> doc
text String
"nand"
ppAtomicOp LlvmAtomicOp
LAO_Or = forall doc. IsLine doc => String -> doc
text String
"or"
ppAtomicOp LlvmAtomicOp
LAO_Xor = forall doc. IsLine doc => String -> doc
text String
"xor"
ppAtomicOp LlvmAtomicOp
LAO_Max = forall doc. IsLine doc => String -> doc
text String
"max"
ppAtomicOp LlvmAtomicOp
LAO_Min = forall doc. IsLine doc => String -> doc
text String
"min"
ppAtomicOp LlvmAtomicOp
LAO_Umax = forall doc. IsLine doc => String -> doc
text String
"umax"
ppAtomicOp LlvmAtomicOp
LAO_Umin = forall doc. IsLine doc => String -> doc
text String
"umin"
ppAtomicRMW :: LlvmCgConfig -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW :: LlvmCgConfig
-> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW LlvmCgConfig
opts LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering =
forall doc. IsLine doc => String -> doc
text String
"atomicrmw" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmAtomicOp -> SDoc
ppAtomicOp LlvmAtomicOp
aop forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
tgt forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
src forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ordering
ppCmpXChg :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar
-> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc
ppCmpXChg :: LlvmCgConfig
-> LlvmVar
-> LlvmVar
-> LlvmVar
-> LlvmSyncOrdering
-> LlvmSyncOrdering
-> SDoc
ppCmpXChg LlvmCgConfig
opts LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord =
forall doc. IsLine doc => String -> doc
text String
"cmpxchg" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
addr forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
old forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
new
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
s_ord forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
f_ord
ppLoad :: LlvmCgConfig -> LlvmVar -> LMAlign -> SDoc
ppLoad :: LlvmCgConfig -> LlvmVar -> LMAlign -> SDoc
ppLoad LlvmCgConfig
opts LlvmVar
var LMAlign
alignment =
forall doc. IsLine doc => String -> doc
text String
"load" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
var forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align
where
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var
align :: SDoc
align =
case LMAlign
alignment of
Just Int
n -> forall doc. IsLine doc => String -> doc
text String
", align" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
n
LMAlign
Nothing -> forall doc. IsOutput doc => doc
empty
ppALoad :: LlvmCgConfig -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
ppALoad :: LlvmCgConfig -> LlvmSyncOrdering -> Bool -> LlvmVar -> SDoc
ppALoad LlvmCgConfig
opts LlvmSyncOrdering
ord Bool
st LlvmVar
var =
let alignment :: Int
alignment = Platform -> LlvmType -> Int
llvmWidthInBits (LlvmCgConfig -> Platform
llvmCgPlatform LlvmCgConfig
opts) (LlvmVar -> LlvmType
getVarType LlvmVar
var) forall a. Integral a => a -> a -> a
`quot` Int
8
align :: SDoc
align = forall doc. IsLine doc => String -> doc
text String
", align" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
alignment
sThreaded :: SDoc
sThreaded | Bool
st = forall doc. IsLine doc => String -> doc
text String
" singlethread"
| Bool
otherwise = forall doc. IsOutput doc => doc
empty
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var
in forall doc. IsLine doc => String -> doc
text String
"load atomic" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
var forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
sThreaded
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ord forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align
ppStore :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> SDoc
ppStore :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> SDoc
ppStore LlvmCgConfig
opts LlvmVar
val LlvmVar
dst LMAlign
alignment =
forall doc. IsLine doc => String -> doc
text String
"store" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
val forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
dst forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
align
where
align :: SDoc
align =
case LMAlign
alignment of
Just Int
n -> forall doc. IsLine doc => String -> doc
text String
", align" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
n
LMAlign
Nothing -> forall doc. IsOutput doc => doc
empty
ppCast :: LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast :: LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast LlvmCgConfig
opts LlvmCastOp
op LlvmVar
from LlvmType
to
= forall a. Outputable a => a -> SDoc
ppr LlvmCastOp
op
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
from) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
from
forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"to"
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
to
ppMalloc :: LlvmCgConfig -> LlvmType -> Int -> SDoc
ppMalloc :: LlvmCgConfig -> LlvmType -> Int -> SDoc
ppMalloc LlvmCgConfig
opts LlvmType
tp Int
amount =
let amount' :: LlvmVar
amount' = LlvmLit -> LlvmVar
LMLitVar forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (forall a. Integral a => a -> Integer
toInteger Int
amount) LlvmType
i32
in forall doc. IsLine doc => String -> doc
text String
"malloc" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
tp forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
amount'
ppAlloca :: LlvmCgConfig -> LlvmType -> Int -> SDoc
ppAlloca :: LlvmCgConfig -> LlvmType -> Int -> SDoc
ppAlloca LlvmCgConfig
opts LlvmType
tp Int
amount =
let amount' :: LlvmVar
amount' = LlvmLit -> LlvmVar
LMLitVar forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (forall a. Integral a => a -> Integer
toInteger Int
amount) LlvmType
i32
in forall doc. IsLine doc => String -> doc
text String
"alloca" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
tp forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
amount'
ppGetElementPtr :: LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr :: LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr LlvmCgConfig
opts Bool
inb LlvmVar
ptr [LlvmVar]
idx =
let indexes :: SDoc
indexes = forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts) [LlvmVar]
idx)
inbound :: SDoc
inbound = if Bool
inb then forall doc. IsLine doc => String -> doc
text String
"inbounds" else forall doc. IsOutput doc => doc
empty
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
ptr
in forall doc. IsLine doc => String -> doc
text String
"getelementptr" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
inbound forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
ptr
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
indexes
ppReturn :: LlvmCgConfig -> Maybe LlvmVar -> SDoc
ppReturn :: LlvmCgConfig -> Maybe LlvmVar -> SDoc
ppReturn LlvmCgConfig
opts (Just LlvmVar
var) = forall doc. IsLine doc => String -> doc
text String
"ret" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
var
ppReturn LlvmCgConfig
_ Maybe LlvmVar
Nothing = forall doc. IsLine doc => String -> doc
text String
"ret" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
LMVoid
ppBranch :: LlvmCgConfig -> LlvmVar -> SDoc
ppBranch :: LlvmCgConfig -> LlvmVar -> SDoc
ppBranch LlvmCgConfig
opts LlvmVar
var = forall doc. IsLine doc => String -> doc
text String
"br" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
var
ppBranchIf :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf LlvmCgConfig
opts LlvmVar
cond LlvmVar
trueT LlvmVar
falseT
= forall doc. IsLine doc => String -> doc
text String
"br" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
cond forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
trueT forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
falseT
ppPhi :: LlvmCgConfig -> LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
ppPhi :: LlvmCgConfig -> LlvmType -> [(LlvmVar, LlvmVar)] -> SDoc
ppPhi LlvmCgConfig
opts LlvmType
tp [(LlvmVar, LlvmVar)]
preds =
let ppPreds :: (LlvmVar, LlvmVar) -> SDoc
ppPreds (LlvmVar
val, LlvmVar
label) = forall doc. IsLine doc => doc -> doc
brackets forall a b. (a -> b) -> a -> b
$ LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
val forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
label
in forall doc. IsLine doc => String -> doc
text String
"phi" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
tp forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => [doc] -> doc
hsep (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LlvmVar, LlvmVar) -> SDoc
ppPreds [(LlvmVar, LlvmVar)]
preds)
ppSwitch :: LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc
ppSwitch :: LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar, LlvmVar)] -> SDoc
ppSwitch LlvmCgConfig
opts LlvmVar
scrut LlvmVar
dflt [(LlvmVar, LlvmVar)]
targets =
let ppTarget :: (LlvmVar, LlvmVar) -> SDoc
ppTarget (LlvmVar
val, LlvmVar
lab) = LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
val forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
lab
ppTargets :: [(LlvmVar, LlvmVar)] -> SDoc
ppTargets [(LlvmVar, LlvmVar)]
xs = forall doc. IsLine doc => doc -> doc
brackets forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (LlvmVar, LlvmVar) -> SDoc
ppTarget [(LlvmVar, LlvmVar)]
xs)
in forall doc. IsLine doc => String -> doc
text String
"switch" forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
scrut forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
dflt
forall doc. IsLine doc => doc -> doc -> doc
<+> [(LlvmVar, LlvmVar)] -> SDoc
ppTargets [(LlvmVar, LlvmVar)]
targets
ppAsm :: LlvmCgConfig -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
ppAsm :: LlvmCgConfig
-> LMString
-> LMString
-> LlvmType
-> [LlvmVar]
-> Bool
-> Bool
-> SDoc
ppAsm LlvmCgConfig
opts LMString
asm LMString
constraints LlvmType
rty [LlvmVar]
vars Bool
sideeffect Bool
alignstack =
let asm' :: SDoc
asm' = forall doc. IsLine doc => doc -> doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => LMString -> doc
ftext LMString
asm
cons :: SDoc
cons = forall doc. IsLine doc => doc -> doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => LMString -> doc
ftext LMString
constraints
rty' :: SDoc
rty' = forall a. Outputable a => a -> SDoc
ppr LlvmType
rty
vars' :: SDoc
vars' = forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts) [LlvmVar]
vars) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
rparen
side :: SDoc
side = if Bool
sideeffect then forall doc. IsLine doc => String -> doc
text String
"sideeffect" else forall doc. IsOutput doc => doc
empty
align :: SDoc
align = if Bool
alignstack then forall doc. IsLine doc => String -> doc
text String
"alignstack" else forall doc. IsOutput doc => doc
empty
in forall doc. IsLine doc => String -> doc
text String
"call" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
rty' forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"asm" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
side forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
align forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
asm' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
cons forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
vars'
ppExtract :: LlvmCgConfig -> LlvmVar -> LlvmVar -> SDoc
LlvmCgConfig
opts LlvmVar
vec LlvmVar
idx =
forall doc. IsLine doc => String -> doc
text String
"extractelement"
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
vec) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
vec forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
idx
ppExtractV :: LlvmCgConfig -> LlvmVar -> Int -> SDoc
LlvmCgConfig
opts LlvmVar
struct Int
idx =
forall doc. IsLine doc => String -> doc
text String
"extractvalue"
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
struct) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
struct forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
idx
ppInsert :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert LlvmCgConfig
opts LlvmVar
vec LlvmVar
elt LlvmVar
idx =
forall doc. IsLine doc => String -> doc
text String
"insertelement"
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
vec) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
vec forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
elt) forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
elt forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
idx
ppMetaStatement :: LlvmCgConfig -> [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement :: LlvmCgConfig -> [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement LlvmCgConfig
opts [MetaAnnot]
meta LlvmStatement
stmt =
LlvmCgConfig -> LlvmStatement -> SDoc
ppLlvmStatement LlvmCgConfig
opts LlvmStatement
stmt forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> [MetaAnnot] -> SDoc
ppMetaAnnots LlvmCgConfig
opts [MetaAnnot]
meta
ppMetaAnnotExpr :: LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaAnnotExpr :: LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaAnnotExpr LlvmCgConfig
opts [MetaAnnot]
meta LlvmExpression
expr =
LlvmCgConfig -> LlvmExpression -> SDoc
ppLlvmExpression LlvmCgConfig
opts LlvmExpression
expr forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> [MetaAnnot] -> SDoc
ppMetaAnnots LlvmCgConfig
opts [MetaAnnot]
meta
ppMetaAnnots :: LlvmCgConfig -> [MetaAnnot] -> SDoc
ppMetaAnnots :: LlvmCgConfig -> [MetaAnnot] -> SDoc
ppMetaAnnots LlvmCgConfig
opts [MetaAnnot]
meta = forall doc. IsLine doc => [doc] -> doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map MetaAnnot -> SDoc
ppMeta [MetaAnnot]
meta
where
ppMeta :: MetaAnnot -> SDoc
ppMeta (MetaAnnot LMString
name MetaExpr
e)
= forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
exclamation forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
name forall doc. IsLine doc => doc -> doc -> doc
<+>
case MetaExpr
e of
MetaNode MetaId
n -> forall a. Outputable a => a -> SDoc
ppr MetaId
n
MetaStruct [MetaExpr]
ms -> SDoc
exclamation forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts) [MetaExpr]
ms))
MetaExpr
other -> SDoc
exclamation forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (LlvmCgConfig -> MetaExpr -> SDoc
ppMetaExpr LlvmCgConfig
opts MetaExpr
other)
ppName :: LlvmCgConfig -> LlvmVar -> SDoc
ppName :: LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
v = case LlvmVar
v of
LMGlobalVar {} -> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName LlvmCgConfig
opts LlvmVar
v
LMLocalVar {} -> forall doc. IsLine doc => Char -> doc
char Char
'%' forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName LlvmCgConfig
opts LlvmVar
v
LMNLocalVar {} -> forall doc. IsLine doc => Char -> doc
char Char
'%' forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName LlvmCgConfig
opts LlvmVar
v
LMLitVar {} -> LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName LlvmCgConfig
opts LlvmVar
v
ppPlainName :: LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName :: LlvmCgConfig -> LlvmVar -> SDoc
ppPlainName LlvmCgConfig
opts LlvmVar
v = case LlvmVar
v of
(LMGlobalVar LMString
x LlvmType
_ LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) -> forall doc. IsLine doc => LMString -> doc
ftext LMString
x
(LMLocalVar LlvmBlockId
x LlvmType
LMLabel ) -> forall doc. IsLine doc => LlvmBlockId -> doc
pprUniqueAlways LlvmBlockId
x
(LMLocalVar LlvmBlockId
x LlvmType
_ ) -> forall doc. IsLine doc => Char -> doc
char Char
'l' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LlvmBlockId -> doc
pprUniqueAlways LlvmBlockId
x
(LMNLocalVar LMString
x LlvmType
_ ) -> forall doc. IsLine doc => LMString -> doc
ftext LMString
x
(LMLitVar LlvmLit
x ) -> LlvmCgConfig -> LlvmLit -> SDoc
ppLit LlvmCgConfig
opts LlvmLit
x
ppLit :: LlvmCgConfig -> LlvmLit -> SDoc
ppLit :: LlvmCgConfig -> LlvmLit -> SDoc
ppLit LlvmCgConfig
opts LlvmLit
l = case LlvmLit
l of
(LMIntLit Integer
i (LMInt Int
32)) -> forall a. Outputable a => a -> SDoc
ppr (forall a. Num a => Integer -> a
fromInteger Integer
i :: Int32)
(LMIntLit Integer
i (LMInt Int
64)) -> forall a. Outputable a => a -> SDoc
ppr (forall a. Num a => Integer -> a
fromInteger Integer
i :: Int64)
(LMIntLit Integer
i LlvmType
_ ) -> forall a. Outputable a => a -> SDoc
ppr ((forall a. Num a => Integer -> a
fromInteger Integer
i)::Int)
(LMFloatLit Double
r LlvmType
LMFloat ) -> Platform -> Float -> SDoc
ppFloat (LlvmCgConfig -> Platform
llvmCgPlatform LlvmCgConfig
opts) forall a b. (a -> b) -> a -> b
$ Double -> Float
narrowFp Double
r
(LMFloatLit Double
r LlvmType
LMDouble) -> Platform -> Double -> SDoc
ppDouble (LlvmCgConfig -> Platform
llvmCgPlatform LlvmCgConfig
opts) Double
r
f :: LlvmLit
f@(LMFloatLit Double
_ LlvmType
_) -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ppLit" (forall doc. IsLine doc => String -> doc
text String
"Can't print this float literal: " forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit LlvmCgConfig
opts LlvmLit
f)
(LMVectorLit [LlvmLit]
ls ) -> forall doc. IsLine doc => Char -> doc
char Char
'<' forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit LlvmCgConfig
opts) [LlvmLit]
ls) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Char -> doc
char Char
'>'
(LMNullLit LlvmType
_ ) -> forall doc. IsLine doc => String -> doc
text String
"null"
(LMUndefLit LlvmType
t )
| LlvmCgConfig -> Bool
llvmCgFillUndefWithGarbage LlvmCgConfig
opts
, Just LlvmLit
lit <- LlvmType -> Maybe LlvmLit
garbageLit LlvmType
t -> LlvmCgConfig -> LlvmLit -> SDoc
ppLit LlvmCgConfig
opts LlvmLit
lit
| Bool
otherwise -> forall doc. IsLine doc => String -> doc
text String
"undef"
ppVar :: LlvmCgConfig -> LlvmVar -> SDoc
ppVar :: LlvmCgConfig -> LlvmVar -> SDoc
ppVar = [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar' []
ppVar' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar' [LlvmParamAttr]
attrs LlvmCgConfig
opts LlvmVar
v = case LlvmVar
v of
LMLitVar LlvmLit
x -> [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit' [LlvmParamAttr]
attrs LlvmCgConfig
opts LlvmLit
x
LlvmVar
x -> forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
x) forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
attrs forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmVar -> SDoc
ppName LlvmCgConfig
opts LlvmVar
x
ppTypeLit :: LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit :: LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit = [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit' []
ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit' [LlvmParamAttr]
attrs LlvmCgConfig
opts LlvmLit
l = case LlvmLit
l of
LMVectorLit {} -> LlvmCgConfig -> LlvmLit -> SDoc
ppLit LlvmCgConfig
opts LlvmLit
l
LlvmLit
_ -> forall a. Outputable a => a -> SDoc
ppr (LlvmLit -> LlvmType
getLitType LlvmLit
l) forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
attrs forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmLit -> SDoc
ppLit LlvmCgConfig
opts LlvmLit
l
ppStatic :: LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic :: LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
st = case LlvmStatic
st of
LMComment LMString
s -> forall doc. IsLine doc => String -> doc
text String
"; " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
s
LMStaticLit LlvmLit
l -> LlvmCgConfig -> LlvmLit -> SDoc
ppTypeLit LlvmCgConfig
opts LlvmLit
l
LMUninitType LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" undef"
LMStaticStr LMString
s LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" c\"" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => LMString -> doc
ftext LMString
s forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"\\00\""
LMStaticArray [LlvmStatic]
d LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" [" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts) [LlvmStatic]
d) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
']'
LMStaticStruc [LlvmStatic]
d LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"<{" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts) [LlvmStatic]
d) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"}>"
LMStaticStrucU [LlvmStatic]
d LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"{" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => [a] -> SDoc
ppCommaJoin (forall a b. (a -> b) -> [a] -> [b]
map (LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts) [LlvmStatic]
d) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"}"
LMStaticPointer LlvmVar
v -> LlvmCgConfig -> LlvmVar -> SDoc
ppVar LlvmCgConfig
opts LlvmVar
v
LMTrunc LlvmStatic
v LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" trunc (" forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
v forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" to " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
')'
LMBitc LlvmStatic
v LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" bitcast (" forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
v forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" to " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
')'
LMPtoI LlvmStatic
v LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" ptrtoint (" forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
v forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" to " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
t forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
')'
LMAdd LlvmStatic
s1 LlvmStatic
s2 -> LlvmCgConfig
-> LlvmStatic -> LlvmStatic -> SDoc -> SDoc -> SDoc -> SDoc
pprStaticArith LlvmCgConfig
opts LlvmStatic
s1 LlvmStatic
s2 (forall doc. IsLine doc => String -> doc
text String
"add") (forall doc. IsLine doc => String -> doc
text String
"fadd") (forall doc. IsLine doc => String -> doc
text String
"LMAdd")
LMSub LlvmStatic
s1 LlvmStatic
s2 -> LlvmCgConfig
-> LlvmStatic -> LlvmStatic -> SDoc -> SDoc -> SDoc -> SDoc
pprStaticArith LlvmCgConfig
opts LlvmStatic
s1 LlvmStatic
s2 (forall doc. IsLine doc => String -> doc
text String
"sub") (forall doc. IsLine doc => String -> doc
text String
"fsub") (forall doc. IsLine doc => String -> doc
text String
"LMSub")
pprSpecialStatic :: LlvmCgConfig -> LlvmStatic -> SDoc
pprSpecialStatic :: LlvmCgConfig -> LlvmStatic -> SDoc
pprSpecialStatic LlvmCgConfig
opts LlvmStatic
stat = case LlvmStatic
stat of
LMBitc LlvmStatic
v LlvmType
t -> forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower LlvmType
t)
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
", bitcast ("
forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
v forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" to " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
t
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
')'
LMStaticPointer LlvmVar
x -> forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
x)
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
stat
LlvmStatic
_ -> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
stat
pprStaticArith :: LlvmCgConfig -> LlvmStatic -> LlvmStatic -> SDoc -> SDoc
-> SDoc -> SDoc
pprStaticArith :: LlvmCgConfig
-> LlvmStatic -> LlvmStatic -> SDoc -> SDoc -> SDoc -> SDoc
pprStaticArith LlvmCgConfig
opts LlvmStatic
s1 LlvmStatic
s2 SDoc
int_op SDoc
float_op SDoc
op_name =
let ty1 :: LlvmType
ty1 = LlvmStatic -> LlvmType
getStatType LlvmStatic
s1
op :: SDoc
op = if LlvmType -> Bool
isFloat LlvmType
ty1 then SDoc
float_op else SDoc
int_op
in if LlvmType
ty1 forall a. Eq a => a -> a -> Bool
== LlvmStatic -> LlvmType
getStatType LlvmStatic
s2
then forall a. Outputable a => a -> SDoc
ppr LlvmType
ty1 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
op forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
lparen forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
s1 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
s2 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
rparen
else forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pprStaticArith" forall a b. (a -> b) -> a -> b
$
SDoc
op_name forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
" with different types! s1: " forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
s1
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
textString
", s2: " forall doc. IsLine doc => doc -> doc -> doc
<> LlvmCgConfig -> LlvmStatic -> SDoc
ppStatic LlvmCgConfig
opts LlvmStatic
s2
newLine :: SDoc
newLine :: SDoc
newLine = forall doc. IsOutput doc => doc
empty
exclamation :: SDoc
exclamation :: SDoc
exclamation = forall doc. IsLine doc => Char -> doc
char Char
'!'