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