{-# LANGUAGE CPP #-}
module Llvm.PpLlvm (
ppLlvmModule,
ppLlvmComments,
ppLlvmComment,
ppLlvmGlobals,
ppLlvmGlobal,
ppLlvmAliases,
ppLlvmAlias,
ppLlvmMetas,
ppLlvmMeta,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
ppLlvmFunction,
) where
#include "HsVersions.h"
import GhcPrelude
import Llvm.AbsSyn
import Llvm.MetaData
import Llvm.Types
import Data.List ( intersperse )
import Outputable
import Unique
import FastString ( sLit )
ppLlvmModule :: LlvmModule -> SDoc
ppLlvmModule :: LlvmModule -> SDoc
ppLlvmModule (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
$+$ [MetaDecl] -> SDoc
ppLlvmMetas [MetaDecl]
meta SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ [LMGlobal] -> SDoc
ppLlvmGlobals [LMGlobal]
globals SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls LlvmFunctionDecls
decls SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ LlvmFunctions -> SDoc
ppLlvmFunctions LlvmFunctions
funcs
ppLlvmComments :: [LMString] -> SDoc
[LMString]
comments = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LMString -> SDoc) -> [LMString] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LMString -> SDoc
ppLlvmComment [LMString]
comments
ppLlvmComment :: LMString -> SDoc
LMString
com = SDoc
semi SDoc -> SDoc -> SDoc
<+> LMString -> SDoc
ftext LMString
com
ppLlvmGlobals :: [LMGlobal] -> SDoc
ppLlvmGlobals :: [LMGlobal] -> SDoc
ppLlvmGlobals [LMGlobal]
ls = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LMGlobal -> SDoc) -> [LMGlobal] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LMGlobal -> SDoc
ppLlvmGlobal [LMGlobal]
ls
ppLlvmGlobal :: LMGlobal -> SDoc
ppLlvmGlobal :: LMGlobal -> SDoc
ppLlvmGlobal (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' -> String -> SDoc
text String
", section" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
doubleQuotes (LMString -> SDoc
ftext LMString
x')
LMSection
Nothing -> SDoc
empty
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> String -> SDoc
text String
", align" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
a'
LMAlign
Nothing -> SDoc
empty
rhs :: SDoc
rhs = case Maybe LlvmStatic
dat of
Just LlvmStatic
stat -> LlvmStatic -> SDoc
pprSpecialStatic LlvmStatic
stat
Maybe LlvmStatic
Nothing -> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower (LlvmType -> LlvmType) -> LlvmType -> LlvmType
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 LlvmVar -> SDoc -> SDoc
ppAssignment LlvmVar
var (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmLinkageType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
link SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
const SDoc -> SDoc -> SDoc
<+> SDoc
rhs SDoc -> SDoc -> SDoc
<> SDoc
sect SDoc -> SDoc -> SDoc
<> SDoc
align
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
ppLlvmGlobal (LMGlobal LlvmVar
var Maybe LlvmStatic
val) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
String -> SDoc
forall a. HasCallStack => String -> a
error (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"Non Global var ppr as global! "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
var) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (Maybe LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe LlvmStatic
val)
ppLlvmAliases :: [LlvmAlias] -> SDoc
ppLlvmAliases :: [LlvmAlias] -> SDoc
ppLlvmAliases [LlvmAlias]
tys = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmAlias -> SDoc) -> [LlvmAlias] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LlvmAlias -> SDoc
ppLlvmAlias [LlvmAlias]
tys
ppLlvmAlias :: LlvmAlias -> SDoc
ppLlvmAlias :: LlvmAlias -> SDoc
ppLlvmAlias (LMString
name, LlvmType
ty)
= Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
name SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"type" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
ty
ppLlvmMetas :: [MetaDecl] -> SDoc
ppLlvmMetas :: [MetaDecl] -> SDoc
ppLlvmMetas [MetaDecl]
metas = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (MetaDecl -> SDoc) -> [MetaDecl] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map MetaDecl -> SDoc
ppLlvmMeta [MetaDecl]
metas
ppLlvmMeta :: MetaDecl -> SDoc
ppLlvmMeta :: MetaDecl -> SDoc
ppLlvmMeta (MetaUnnamed MetaId
n MetaExpr
m)
= MetaId -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaId
n SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> MetaExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaExpr
m
ppLlvmMeta (MetaNamed LMString
n [MetaId]
m)
= SDoc
exclamation SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
n SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> SDoc
exclamation SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces SDoc
nodes
where
nodes :: SDoc
nodes = [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (MetaId -> SDoc) -> [MetaId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map MetaId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [MetaId]
m
ppLlvmFunctions :: LlvmFunctions -> SDoc
ppLlvmFunctions :: LlvmFunctions -> SDoc
ppLlvmFunctions LlvmFunctions
funcs = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmFunction -> SDoc) -> LlvmFunctions -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LlvmFunction -> SDoc
ppLlvmFunction LlvmFunctions
funcs
ppLlvmFunction :: LlvmFunction -> SDoc
ppLlvmFunction :: LlvmFunction -> SDoc
ppLlvmFunction LlvmFunction
fun =
let attrDoc :: SDoc
attrDoc = [LlvmFuncAttr] -> SDoc
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' -> String -> SDoc
text String
"section" SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LMString -> SDoc
ftext LMString
s')
LMSection
Nothing -> SDoc
empty
prefixDoc :: SDoc
prefixDoc = case LlvmFunction -> Maybe LlvmStatic
funcPrefix LlvmFunction
fun of
Just LlvmStatic
v -> String -> SDoc
text String
"prefix" SDoc -> SDoc -> SDoc
<+> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v
Maybe LlvmStatic
Nothing -> SDoc
empty
in String -> SDoc
text String
"define" SDoc -> SDoc -> SDoc
<+> LlvmFunctionDecl -> [LMString] -> SDoc
ppLlvmFunctionHeader (LlvmFunction -> LlvmFunctionDecl
funcDecl LlvmFunction
fun) (LlvmFunction -> [LMString]
funcArgs LlvmFunction
fun)
SDoc -> SDoc -> SDoc
<+> SDoc
attrDoc SDoc -> SDoc -> SDoc
<+> SDoc
secDoc SDoc -> SDoc -> SDoc
<+> SDoc
prefixDoc
SDoc -> SDoc -> SDoc
$+$ SDoc
lbrace
SDoc -> SDoc -> SDoc
$+$ LlvmBlocks -> SDoc
ppLlvmBlocks (LlvmFunction -> LlvmBlocks
funcBody LlvmFunction
fun)
SDoc -> SDoc -> SDoc
$+$ SDoc
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' :: PtrString
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | [LlvmParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmParameter]
p -> String -> PtrString
sLit String
"..."
| Bool
otherwise -> String -> PtrString
sLit String
", ..."
LlvmParameterListType
_otherwise -> String -> PtrString
sLit String
""
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> String -> SDoc
text String
" align " SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> SDoc
empty
args' :: [SDoc]
args' = ((LlvmParameter, LMString) -> SDoc)
-> [(LlvmParameter, LMString)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\((LlvmType
ty,[LlvmParamAttr]
p),LMString
n) -> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
ty SDoc -> SDoc -> SDoc
<+> [LlvmParamAttr] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
p SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'%'
SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
n)
([LlvmParameter] -> [LMString] -> [(LlvmParameter, LMString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LlvmParameter]
p [LMString]
args)
in LlvmLinkageType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l SDoc -> SDoc -> SDoc
<+> LlvmCallConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
n SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<>
([SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
args') SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
varg' SDoc -> SDoc -> SDoc
<> SDoc
rparen SDoc -> SDoc -> SDoc
<> SDoc
align
ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
ppLlvmFunctionDecls LlvmFunctionDecls
decs = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmFunctionDecl -> SDoc) -> LlvmFunctionDecls -> [SDoc]
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' :: PtrString
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | [LlvmParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmParameter]
p -> String -> PtrString
sLit String
"..."
| Bool
otherwise -> String -> PtrString
sLit String
", ..."
LlvmParameterListType
_otherwise -> String -> PtrString
sLit String
""
align :: SDoc
align = case LMAlign
a of
Just Int
a' -> String -> SDoc
text String
" align" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> SDoc
empty
args :: SDoc
args = [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse (SDoc
comma SDoc -> SDoc -> SDoc
<> SDoc
space) ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
(LlvmParameter -> SDoc) -> [LlvmParameter] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(LlvmType
t,[LlvmParamAttr]
a) -> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<+> [LlvmParamAttr] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmParamAttr]
a) [LlvmParameter]
p
in String -> SDoc
text String
"declare" SDoc -> SDoc -> SDoc
<+> LlvmLinkageType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l SDoc -> SDoc -> SDoc
<+> LlvmCallConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<>
LMString -> SDoc
ftext LMString
n SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> SDoc
args SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
varg' SDoc -> SDoc -> SDoc
<> SDoc
rparen SDoc -> SDoc -> SDoc
<> SDoc
align SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
ppLlvmBlocks :: LlvmBlocks -> SDoc
ppLlvmBlocks :: LlvmBlocks -> SDoc
ppLlvmBlocks LlvmBlocks
blocks = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmBlock -> SDoc) -> LlvmBlocks -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LlvmBlock -> SDoc
ppLlvmBlock LlvmBlocks
blocks
ppLlvmBlock :: LlvmBlock -> SDoc
ppLlvmBlock :: LlvmBlock -> SDoc
ppLlvmBlock (LlvmBlock LlvmBlockId
blockId [LlvmStatement]
stmts) =
let isLabel :: LlvmStatement -> Bool
isLabel (MkLabel LlvmBlockId
_) = Bool
True
isLabel LlvmStatement
_ = Bool
False
([LlvmStatement]
block, [LlvmStatement]
rest) = (LlvmStatement -> Bool)
-> [LlvmStatement] -> ([LlvmStatement], [LlvmStatement])
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 -> LlvmBlock -> SDoc
ppLlvmBlock (LlvmBlockId -> [LlvmStatement] -> LlvmBlock
LlvmBlock LlvmBlockId
id [LlvmStatement]
xs)
[LlvmStatement]
_ -> SDoc
empty
in LlvmBlockId -> SDoc
ppLlvmBlockLabel LlvmBlockId
blockId
SDoc -> SDoc -> SDoc
$+$ ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmStatement -> SDoc) -> [LlvmStatement] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LlvmStatement -> SDoc
ppLlvmStatement [LlvmStatement]
block)
SDoc -> SDoc -> SDoc
$+$ SDoc
newLine
SDoc -> SDoc -> SDoc
$+$ SDoc
ppRest
ppLlvmBlockLabel :: LlvmBlockId -> SDoc
ppLlvmBlockLabel :: LlvmBlockId -> SDoc
ppLlvmBlockLabel LlvmBlockId
id = LlvmBlockId -> SDoc
pprUniqueAlways LlvmBlockId
id SDoc -> SDoc -> SDoc
<> SDoc
colon
ppLlvmStatement :: LlvmStatement -> SDoc
ppLlvmStatement :: LlvmStatement -> SDoc
ppLlvmStatement LlvmStatement
stmt =
let ind :: SDoc -> SDoc
ind = (String -> SDoc
text String
" " SDoc -> SDoc -> SDoc
<>)
in case LlvmStatement
stmt of
Assignment LlvmVar
dst LlvmExpression
expr -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> SDoc -> SDoc
ppAssignment LlvmVar
dst (LlvmExpression -> SDoc
ppLlvmExpression LlvmExpression
expr)
Fence Bool
st LlvmSyncOrdering
ord -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> LlvmSyncOrdering -> SDoc
ppFence Bool
st LlvmSyncOrdering
ord
Branch LlvmVar
target -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> SDoc
ppBranch LlvmVar
target
BranchIf LlvmVar
cond LlvmVar
ifT LlvmVar
ifF -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf LlvmVar
cond LlvmVar
ifT LlvmVar
ifF
Comment [LMString]
comments -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
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 -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmVar -> SDoc
ppStore LlvmVar
value LlvmVar
ptr
Switch LlvmVar
scrut LlvmVar
def [(LlvmVar, LlvmVar)]
tgs -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmVar -> [(LlvmVar, LlvmVar)] -> SDoc
ppSwitch LlvmVar
scrut LlvmVar
def [(LlvmVar, LlvmVar)]
tgs
Return Maybe LlvmVar
result -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Maybe LlvmVar -> SDoc
ppReturn Maybe LlvmVar
result
Expr LlvmExpression
expr -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmExpression -> SDoc
ppLlvmExpression LlvmExpression
expr
LlvmStatement
Unreachable -> SDoc -> SDoc
ind (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"unreachable"
LlvmStatement
Nop -> SDoc
empty
MetaStmt [MetaAnnot]
meta LlvmStatement
s -> [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement [MetaAnnot]
meta LlvmStatement
s
ppLlvmExpression :: LlvmExpression -> SDoc
ppLlvmExpression :: LlvmExpression -> SDoc
ppLlvmExpression LlvmExpression
expr
= case LlvmExpression
expr of
Alloca LlvmType
tp Int
amount -> LlvmType -> Int -> SDoc
ppAlloca LlvmType
tp Int
amount
LlvmOp LlvmMachOp
op LlvmVar
left LlvmVar
right -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp LlvmMachOp
op LlvmVar
left LlvmVar
right
Call LlvmCallType
tp LlvmVar
fp [LlvmVar]
args [LlvmFuncAttr]
attrs -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall LlvmCallType
tp LlvmVar
fp ((LlvmVar -> MetaExpr) -> [LlvmVar] -> [MetaExpr]
forall a b. (a -> b) -> [a] -> [b]
map LlvmVar -> MetaExpr
MetaVar [LlvmVar]
args) [LlvmFuncAttr]
attrs
CallM LlvmCallType
tp LlvmVar
fp [MetaExpr]
args [LlvmFuncAttr]
attrs -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall LlvmCallType
tp LlvmVar
fp [MetaExpr]
args [LlvmFuncAttr]
attrs
Cast LlvmCastOp
op LlvmVar
from LlvmType
to -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast LlvmCastOp
op LlvmVar
from LlvmType
to
Compare LlvmCmpOp
op LlvmVar
left LlvmVar
right -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp LlvmCmpOp
op LlvmVar
left LlvmVar
right
Extract LlvmVar
vec LlvmVar
idx -> LlvmVar -> LlvmVar -> SDoc
ppExtract LlvmVar
vec LlvmVar
idx
ExtractV LlvmVar
struct Int
idx -> LlvmVar -> Int -> SDoc
ppExtractV LlvmVar
struct Int
idx
Insert LlvmVar
vec LlvmVar
elt LlvmVar
idx -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert LlvmVar
vec LlvmVar
elt LlvmVar
idx
GetElemPtr Bool
inb LlvmVar
ptr [LlvmVar]
indexes -> Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr Bool
inb LlvmVar
ptr [LlvmVar]
indexes
Load LlvmVar
ptr -> LlvmVar -> SDoc
ppLoad LlvmVar
ptr
ALoad LlvmSyncOrdering
ord Bool
st LlvmVar
ptr -> LlvmSyncOrdering -> Bool -> LlvmVar -> SDoc
ppALoad LlvmSyncOrdering
ord Bool
st LlvmVar
ptr
Malloc LlvmType
tp Int
amount -> LlvmType -> Int -> SDoc
ppMalloc LlvmType
tp Int
amount
AtomicRMW LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering
CmpXChg LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord -> LlvmVar
-> LlvmVar
-> LlvmVar
-> LlvmSyncOrdering
-> LlvmSyncOrdering
-> SDoc
ppCmpXChg LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord
Phi LlvmType
tp [(LlvmVar, LlvmVar)]
predecessors -> LlvmType -> [(LlvmVar, LlvmVar)] -> SDoc
ppPhi LlvmType
tp [(LlvmVar, LlvmVar)]
predecessors
Asm LMString
asm LMString
c LlvmType
ty [LlvmVar]
v Bool
se Bool
sk -> LMString
-> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
ppAsm LMString
asm LMString
c LlvmType
ty [LlvmVar]
v Bool
se Bool
sk
MExpr [MetaAnnot]
meta LlvmExpression
expr -> [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaExpr [MetaAnnot]
meta LlvmExpression
expr
ppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
ppCall 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 -> String -> SDoc
forall a. HasCallStack => String -> a
error (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"ppCall called with non LMFunction type!\nMust be "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" called with either global var of function type or "
String -> String -> String
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 LlvmCallType -> LlvmCallType -> Bool
forall a. Eq a => a -> a -> Bool
== LlvmCallType
TailCall then String -> SDoc
text String
"tail " else SDoc
empty
ppValues :: SDoc
ppValues = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (MetaExpr -> SDoc) -> [MetaExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map MetaExpr -> SDoc
ppCallMetaExpr [MetaExpr]
args
ppArgTy :: SDoc
ppArgTy = ([LlvmType] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin ([LlvmType] -> SDoc) -> [LlvmType] -> SDoc
forall a b. (a -> b) -> a -> b
$ (LlvmParameter -> LlvmType) -> [LlvmParameter] -> [LlvmType]
forall a b. (a -> b) -> [a] -> [b]
map LlvmParameter -> LlvmType
forall a b. (a, b) -> a
fst [LlvmParameter]
params) SDoc -> SDoc -> SDoc
<>
(case LlvmParameterListType
argTy of
LlvmParameterListType
VarArgs -> String -> SDoc
text String
", ..."
LlvmParameterListType
FixedArgs -> SDoc
empty)
fnty :: SDoc
fnty = SDoc
space SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> SDoc
ppArgTy SDoc -> SDoc -> SDoc
<> SDoc
rparen
attrDoc :: SDoc
attrDoc = [LlvmFuncAttr] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [LlvmFuncAttr]
attrs
in SDoc
tc SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"call" SDoc -> SDoc -> SDoc
<+> LlvmCallConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
cc SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
ret
SDoc -> SDoc -> SDoc
<> SDoc
fnty SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
fptr SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<+> SDoc
ppValues
SDoc -> SDoc -> SDoc
<+> SDoc
rparen SDoc -> SDoc -> SDoc
<+> SDoc
attrDoc
ppCallMetaExpr :: MetaExpr -> SDoc
ppCallMetaExpr (MetaVar LlvmVar
v) = LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
v
ppCallMetaExpr MetaExpr
v = String -> SDoc
text String
"metadata" SDoc -> SDoc -> SDoc
<+> MetaExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaExpr
v
ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
ppMachOp LlvmMachOp
op LlvmVar
left LlvmVar
right =
(LlvmMachOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmMachOp
op) SDoc -> SDoc -> SDoc
<+> (LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
left)) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
left
SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
right
ppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
ppCmpOp 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) = String -> SDoc
text String
"icmp"
| LlvmType -> Bool
isFloat (LlvmVar -> LlvmType
getVarType LlvmVar
left) Bool -> Bool -> Bool
&& LlvmType -> Bool
isFloat (LlvmVar -> LlvmType
getVarType LlvmVar
right) = String -> SDoc
text String
"fcmp"
| Bool
otherwise = String -> SDoc
text String
"icmp"
in SDoc
cmpOp SDoc -> SDoc -> SDoc
<+> LlvmCmpOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCmpOp
op SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
left)
SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
left SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
right
ppAssignment :: LlvmVar -> SDoc -> SDoc
ppAssignment :: LlvmVar -> SDoc -> SDoc
ppAssignment LlvmVar
var SDoc
expr = LlvmVar -> SDoc
ppName LlvmVar
var SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> 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 -> String -> SDoc
text String
"singlethread"
Bool
False -> SDoc
empty
in String -> SDoc
text String
"fence" SDoc -> SDoc -> SDoc
<+> SDoc
singleThread SDoc -> SDoc -> SDoc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ord
ppSyncOrdering :: LlvmSyncOrdering -> SDoc
ppSyncOrdering :: LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
SyncUnord = String -> SDoc
text String
"unordered"
ppSyncOrdering LlvmSyncOrdering
SyncMonotonic = String -> SDoc
text String
"monotonic"
ppSyncOrdering LlvmSyncOrdering
SyncAcquire = String -> SDoc
text String
"acquire"
ppSyncOrdering LlvmSyncOrdering
SyncRelease = String -> SDoc
text String
"release"
ppSyncOrdering LlvmSyncOrdering
SyncAcqRel = String -> SDoc
text String
"acq_rel"
ppSyncOrdering LlvmSyncOrdering
SyncSeqCst = String -> SDoc
text String
"seq_cst"
ppAtomicOp :: LlvmAtomicOp -> SDoc
ppAtomicOp :: LlvmAtomicOp -> SDoc
ppAtomicOp LlvmAtomicOp
LAO_Xchg = String -> SDoc
text String
"xchg"
ppAtomicOp LlvmAtomicOp
LAO_Add = String -> SDoc
text String
"add"
ppAtomicOp LlvmAtomicOp
LAO_Sub = String -> SDoc
text String
"sub"
ppAtomicOp LlvmAtomicOp
LAO_And = String -> SDoc
text String
"and"
ppAtomicOp LlvmAtomicOp
LAO_Nand = String -> SDoc
text String
"nand"
ppAtomicOp LlvmAtomicOp
LAO_Or = String -> SDoc
text String
"or"
ppAtomicOp LlvmAtomicOp
LAO_Xor = String -> SDoc
text String
"xor"
ppAtomicOp LlvmAtomicOp
LAO_Max = String -> SDoc
text String
"max"
ppAtomicOp LlvmAtomicOp
LAO_Min = String -> SDoc
text String
"min"
ppAtomicOp LlvmAtomicOp
LAO_Umax = String -> SDoc
text String
"umax"
ppAtomicOp LlvmAtomicOp
LAO_Umin = String -> SDoc
text String
"umin"
ppAtomicRMW :: LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW :: LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc
ppAtomicRMW LlvmAtomicOp
aop LlvmVar
tgt LlvmVar
src LlvmSyncOrdering
ordering =
String -> SDoc
text String
"atomicrmw" SDoc -> SDoc -> SDoc
<+> LlvmAtomicOp -> SDoc
ppAtomicOp LlvmAtomicOp
aop SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
tgt SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
src SDoc -> SDoc -> SDoc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ordering
ppCmpXChg :: LlvmVar -> LlvmVar -> LlvmVar
-> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc
ppCmpXChg :: LlvmVar
-> LlvmVar
-> LlvmVar
-> LlvmSyncOrdering
-> LlvmSyncOrdering
-> SDoc
ppCmpXChg LlvmVar
addr LlvmVar
old LlvmVar
new LlvmSyncOrdering
s_ord LlvmSyncOrdering
f_ord =
String -> SDoc
text String
"cmpxchg" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
addr SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
old SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
new
SDoc -> SDoc -> SDoc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
s_ord SDoc -> SDoc -> SDoc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
f_ord
ppLoad :: LlvmVar -> SDoc
ppLoad :: LlvmVar -> SDoc
ppLoad LlvmVar
var = String -> SDoc
text String
"load" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
var SDoc -> SDoc -> SDoc
<> SDoc
align
where
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var
align :: SDoc
align | LlvmType -> Bool
isVector (LlvmType -> Bool) -> (LlvmVar -> LlvmType) -> LlvmVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmType -> LlvmType
pLower (LlvmType -> LlvmType)
-> (LlvmVar -> LlvmType) -> LlvmVar -> LlvmType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmVar -> LlvmType
getVarType (LlvmVar -> Bool) -> LlvmVar -> Bool
forall a b. (a -> b) -> a -> b
$ LlvmVar
var = String -> SDoc
text String
", align 1"
| Bool
otherwise = SDoc
empty
ppALoad :: LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
ppALoad :: LlvmSyncOrdering -> Bool -> LlvmVar -> SDoc
ppALoad LlvmSyncOrdering
ord Bool
st LlvmVar
var = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
let alignment :: Int
alignment = (DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags (LlvmType -> Int) -> LlvmType -> Int
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
align :: SDoc
align = String -> SDoc
text String
", align" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
alignment
sThreaded :: SDoc
sThreaded | Bool
st = String -> SDoc
text String
" singlethread"
| Bool
otherwise = SDoc
empty
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
var
in String -> SDoc
text String
"load atomic" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
var SDoc -> SDoc -> SDoc
<> SDoc
sThreaded
SDoc -> SDoc -> SDoc
<+> LlvmSyncOrdering -> SDoc
ppSyncOrdering LlvmSyncOrdering
ord SDoc -> SDoc -> SDoc
<> SDoc
align
ppStore :: LlvmVar -> LlvmVar -> SDoc
ppStore :: LlvmVar -> LlvmVar -> SDoc
ppStore LlvmVar
val LlvmVar
dst
| LlvmVar -> Bool
isVecPtrVar LlvmVar
dst = String -> SDoc
text String
"store" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
val SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
dst SDoc -> SDoc -> SDoc
<>
SDoc
comma SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"align 1"
| Bool
otherwise = String -> SDoc
text String
"store" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
val SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
dst
where
isVecPtrVar :: LlvmVar -> Bool
isVecPtrVar :: LlvmVar -> Bool
isVecPtrVar = LlvmType -> Bool
isVector (LlvmType -> Bool) -> (LlvmVar -> LlvmType) -> LlvmVar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmType -> LlvmType
pLower (LlvmType -> LlvmType)
-> (LlvmVar -> LlvmType) -> LlvmVar -> LlvmType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmVar -> LlvmType
getVarType
ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
ppCast LlvmCastOp
op LlvmVar
from LlvmType
to
= LlvmCastOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCastOp
op
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
from) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
from
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"to"
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
to
ppMalloc :: LlvmType -> Int -> SDoc
ppMalloc :: LlvmType -> Int -> SDoc
ppMalloc LlvmType
tp Int
amount =
let amount' :: LlvmVar
amount' = LlvmLit -> LlvmVar
LMLitVar (LlvmLit -> LlvmVar) -> LlvmLit -> LlvmVar
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
amount) LlvmType
i32
in String -> SDoc
text String
"malloc" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
amount'
ppAlloca :: LlvmType -> Int -> SDoc
ppAlloca :: LlvmType -> Int -> SDoc
ppAlloca LlvmType
tp Int
amount =
let amount' :: LlvmVar
amount' = LlvmLit -> LlvmVar
LMLitVar (LlvmLit -> LlvmVar) -> LlvmLit -> LlvmVar
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
amount) LlvmType
i32
in String -> SDoc
text String
"alloca" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
amount'
ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
ppGetElementPtr Bool
inb LlvmVar
ptr [LlvmVar]
idx =
let indexes :: SDoc
indexes = SDoc
comma SDoc -> SDoc -> SDoc
<+> [LlvmVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmVar]
idx
inbound :: SDoc
inbound = if Bool
inb then String -> SDoc
text String
"inbounds" else SDoc
empty
derefType :: LlvmType
derefType = LlvmType -> LlvmType
pLower (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
ptr
in String -> SDoc
text String
"getelementptr" SDoc -> SDoc -> SDoc
<+> SDoc
inbound SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
derefType SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
ptr
SDoc -> SDoc -> SDoc
<> SDoc
indexes
ppReturn :: Maybe LlvmVar -> SDoc
ppReturn :: Maybe LlvmVar -> SDoc
ppReturn (Just LlvmVar
var) = String -> SDoc
text String
"ret" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
var
ppReturn Maybe LlvmVar
Nothing = String -> SDoc
text String
"ret" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
LMVoid
ppBranch :: LlvmVar -> SDoc
ppBranch :: LlvmVar -> SDoc
ppBranch LlvmVar
var = String -> SDoc
text String
"br" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
var
ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppBranchIf LlvmVar
cond LlvmVar
trueT LlvmVar
falseT
= String -> SDoc
text String
"br" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
cond SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
trueT SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
falseT
ppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
ppPhi :: LlvmType -> [(LlvmVar, LlvmVar)] -> SDoc
ppPhi LlvmType
tp [(LlvmVar, LlvmVar)]
preds =
let ppPreds :: (LlvmVar, LlvmVar) -> SDoc
ppPreds (LlvmVar
val, LlvmVar
label) = SDoc -> SDoc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LlvmVar -> SDoc
ppName LlvmVar
val SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
label
in String -> SDoc
text String
"phi" SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ ((LlvmVar, LlvmVar) -> SDoc) -> [(LlvmVar, LlvmVar)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LlvmVar, LlvmVar) -> SDoc
ppPreds [(LlvmVar, LlvmVar)]
preds)
ppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc
ppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar, LlvmVar)] -> SDoc
ppSwitch LlvmVar
scrut LlvmVar
dflt [(LlvmVar, LlvmVar)]
targets =
let ppTarget :: (a, a) -> SDoc
ppTarget (a
val, a
lab) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
val SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
lab
ppTargets :: [(a, a)] -> SDoc
ppTargets [(a, a)]
xs = SDoc -> SDoc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat (((a, a) -> SDoc) -> [(a, a)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> SDoc
forall a a. (Outputable a, Outputable a) => (a, a) -> SDoc
ppTarget [(a, a)]
xs)
in String -> SDoc
text String
"switch" SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
scrut SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
dflt
SDoc -> SDoc -> SDoc
<+> [(LlvmVar, LlvmVar)] -> SDoc
forall a a. (Outputable a, Outputable a) => [(a, a)] -> SDoc
ppTargets [(LlvmVar, LlvmVar)]
targets
ppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
ppAsm :: LMString
-> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
ppAsm LMString
asm LMString
constraints LlvmType
rty [LlvmVar]
vars Bool
sideeffect Bool
alignstack =
let asm' :: SDoc
asm' = SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LMString -> SDoc
ftext LMString
asm
cons :: SDoc
cons = SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LMString -> SDoc
ftext LMString
constraints
rty' :: SDoc
rty' = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
rty
vars' :: SDoc
vars' = SDoc
lparen SDoc -> SDoc -> SDoc
<+> [LlvmVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmVar]
vars SDoc -> SDoc -> SDoc
<+> SDoc
rparen
side :: SDoc
side = if Bool
sideeffect then String -> SDoc
text String
"sideeffect" else SDoc
empty
align :: SDoc
align = if Bool
alignstack then String -> SDoc
text String
"alignstack" else SDoc
empty
in String -> SDoc
text String
"call" SDoc -> SDoc -> SDoc
<+> SDoc
rty' SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"asm" SDoc -> SDoc -> SDoc
<+> SDoc
side SDoc -> SDoc -> SDoc
<+> SDoc
align SDoc -> SDoc -> SDoc
<+> SDoc
asm' SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> SDoc
cons SDoc -> SDoc -> SDoc
<> SDoc
vars'
ppExtract :: LlvmVar -> LlvmVar -> SDoc
LlvmVar
vec LlvmVar
idx =
String -> SDoc
text String
"extractelement"
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
vec) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
vec SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
idx
ppExtractV :: LlvmVar -> Int -> SDoc
LlvmVar
struct Int
idx =
String -> SDoc
text String
"extractvalue"
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
struct) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
struct SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
idx
ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
ppInsert LlvmVar
vec LlvmVar
elt LlvmVar
idx =
String -> SDoc
text String
"insertelement"
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
vec) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
vec SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
elt) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
elt SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
idx
ppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc
ppMetaStatement [MetaAnnot]
meta LlvmStatement
stmt = LlvmStatement -> SDoc
ppLlvmStatement LlvmStatement
stmt SDoc -> SDoc -> SDoc
<> [MetaAnnot] -> SDoc
ppMetaAnnots [MetaAnnot]
meta
ppMetaExpr :: [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaExpr :: [MetaAnnot] -> LlvmExpression -> SDoc
ppMetaExpr [MetaAnnot]
meta LlvmExpression
expr = LlvmExpression -> SDoc
ppLlvmExpression LlvmExpression
expr SDoc -> SDoc -> SDoc
<> [MetaAnnot] -> SDoc
ppMetaAnnots [MetaAnnot]
meta
ppMetaAnnots :: [MetaAnnot] -> SDoc
ppMetaAnnots :: [MetaAnnot] -> SDoc
ppMetaAnnots [MetaAnnot]
meta = [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (MetaAnnot -> SDoc) -> [MetaAnnot] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map MetaAnnot -> SDoc
ppMeta [MetaAnnot]
meta
where
ppMeta :: MetaAnnot -> SDoc
ppMeta (MetaAnnot LMString
name MetaExpr
e)
= SDoc
comma SDoc -> SDoc -> SDoc
<+> SDoc
exclamation SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
name SDoc -> SDoc -> SDoc
<+>
case MetaExpr
e of
MetaNode MetaId
n -> MetaId -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaId
n
MetaStruct [MetaExpr]
ms -> SDoc
exclamation SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([MetaExpr] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [MetaExpr]
ms)
MetaExpr
other -> SDoc
exclamation SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (MetaExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr MetaExpr
other)
newLine :: SDoc
newLine :: SDoc
newLine = SDoc
empty
exclamation :: SDoc
exclamation :: SDoc
exclamation = Char -> SDoc
char Char
'!'