{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Llvm.Types where
#include "HsVersions.h"
import GHC.Prelude
import Data.Char
import Numeric
import GHC.Platform
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.CmmToAsm.Ppr
import GHC.Float
data LMGlobal = LMGlobal {
LMGlobal -> LlvmVar
getGlobalVar :: LlvmVar,
LMGlobal -> Maybe LlvmStatic
getGlobalValue :: Maybe LlvmStatic
}
type LMString = FastString
type LlvmAlias = (LMString, LlvmType)
data LlvmType
= LMInt Int
| LMFloat
| LMDouble
| LMFloat80
| LMFloat128
| LMPointer LlvmType
| LMArray Int LlvmType
| LMVector Int LlvmType
| LMLabel
| LMVoid
| LMStruct [LlvmType]
| LMStructU [LlvmType]
| LMAlias LlvmAlias
| LMMetadata
| LMFunction LlvmFunctionDecl
deriving (LlvmType -> LlvmType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmType -> LlvmType -> Bool
$c/= :: LlvmType -> LlvmType -> Bool
== :: LlvmType -> LlvmType -> Bool
$c== :: LlvmType -> LlvmType -> Bool
Eq)
instance Outputable LlvmType where
ppr :: LlvmType -> SDoc
ppr = LlvmType -> SDoc
ppType
ppType :: LlvmType -> SDoc
ppType :: LlvmType -> SDoc
ppType LlvmType
t = case LlvmType
t of
LMInt Int
size -> Char -> SDoc
char Char
'i' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Int
size
LlvmType
LMFloat -> String -> SDoc
text String
"float"
LlvmType
LMDouble -> String -> SDoc
text String
"double"
LlvmType
LMFloat80 -> String -> SDoc
text String
"x86_fp80"
LlvmType
LMFloat128 -> String -> SDoc
text String
"fp128"
LMPointer LlvmType
x -> forall a. Outputable a => a -> SDoc
ppr LlvmType
x SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'*'
LMArray Int
nr LlvmType
tp -> Char -> SDoc
char Char
'[' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Int
nr SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" x " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
']'
LMVector Int
nr LlvmType
tp -> Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Int
nr SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" x " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'>'
LlvmType
LMLabel -> String -> SDoc
text String
"label"
LlvmType
LMVoid -> String -> SDoc
text String
"void"
LMStruct [LlvmType]
tys -> String -> SDoc
text String
"<{" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmType]
tys SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"}>"
LMStructU [LlvmType]
tys -> String -> SDoc
text String
"{" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmType]
tys SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"}"
LlvmType
LMMetadata -> String -> SDoc
text String
"metadata"
LMAlias (FastString
s,LlvmType
_) -> Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext FastString
s
LMFunction (LlvmFunctionDecl FastString
_ LlvmLinkageType
_ LlvmCallConvention
_ LlvmType
r LlvmParameterListType
varg [LlvmParameter]
p LMAlign
_)
-> forall a. Outputable a => a -> SDoc
ppr LlvmType
r SDoc -> SDoc -> SDoc
<+> SDoc
lparen SDoc -> SDoc -> SDoc
<> LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams LlvmParameterListType
varg [LlvmParameter]
p SDoc -> SDoc -> SDoc
<> SDoc
rparen
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams LlvmParameterListType
varg [LlvmParameter]
p
= let varg' :: PtrString
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmType]
args -> String -> PtrString
sLit String
"..."
| Bool
otherwise -> String -> PtrString
sLit String
", ..."
LlvmParameterListType
_otherwise -> String -> PtrString
sLit String
""
args :: [LlvmType]
args = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [LlvmParameter]
p
in forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmType]
args SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
varg'
type LMSection = Maybe LMString
type LMAlign = Maybe Int
data LMConst = Global
| Constant
| Alias
deriving (LMConst -> LMConst -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LMConst -> LMConst -> Bool
$c/= :: LMConst -> LMConst -> Bool
== :: LMConst -> LMConst -> Bool
$c== :: LMConst -> LMConst -> Bool
Eq)
data LlvmVar
= LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst
| LMLocalVar Unique LlvmType
| LMNLocalVar LMString LlvmType
| LMLitVar LlvmLit
deriving (LlvmVar -> LlvmVar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmVar -> LlvmVar -> Bool
$c/= :: LlvmVar -> LlvmVar -> Bool
== :: LlvmVar -> LlvmVar -> Bool
$c== :: LlvmVar -> LlvmVar -> Bool
Eq)
data LlvmLit
= LMIntLit Integer LlvmType
| LMFloatLit Double LlvmType
| LMNullLit LlvmType
| LMVectorLit [LlvmLit]
| LMUndefLit LlvmType
deriving (LlvmLit -> LlvmLit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmLit -> LlvmLit -> Bool
$c/= :: LlvmLit -> LlvmLit -> Bool
== :: LlvmLit -> LlvmLit -> Bool
$c== :: LlvmLit -> LlvmLit -> Bool
Eq)
data LlvmStatic
= LMString
| LMStaticLit LlvmLit
| LMUninitType LlvmType
| LMStaticStr LMString LlvmType
| LMStaticArray [LlvmStatic] LlvmType
| LMStaticStruc [LlvmStatic] LlvmType
| LMStaticPointer LlvmVar
| LMTrunc LlvmStatic LlvmType
| LMBitc LlvmStatic LlvmType
| LMPtoI LlvmStatic LlvmType
| LMAdd LlvmStatic LlvmStatic
| LMSub LlvmStatic LlvmStatic
data LlvmOpts = LlvmOpts
{ LlvmOpts -> Platform
llvmOptsPlatform :: !Platform
, LlvmOpts -> Bool
llvmOptsFillUndefWithGarbage :: !Bool
, LlvmOpts -> Bool
llvmOptsSplitSections :: !Bool
}
initLlvmOpts :: DynFlags -> LlvmOpts
initLlvmOpts :: DynFlags -> LlvmOpts
initLlvmOpts DynFlags
dflags = LlvmOpts
{ llvmOptsPlatform :: Platform
llvmOptsPlatform = DynFlags -> Platform
targetPlatform DynFlags
dflags
, llvmOptsFillUndefWithGarbage :: Bool
llvmOptsFillUndefWithGarbage = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LlvmFillUndefWithGarbage DynFlags
dflags
, llvmOptsSplitSections :: Bool
llvmOptsSplitSections = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SplitSections DynFlags
dflags
}
garbageLit :: LlvmType -> Maybe LlvmLit
garbageLit :: LlvmType -> Maybe LlvmLit
garbageLit t :: LlvmType
t@(LMInt Int
w) = forall a. a -> Maybe a
Just (Integer -> LlvmType -> LlvmLit
LMIntLit (Integer
0xbbbbbbbbbbbbbbb0 forall a. Integral a => a -> a -> a
`mod` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
w)) LlvmType
t)
garbageLit LlvmType
t
| LlvmType -> Bool
isFloat LlvmType
t = forall a. a -> Maybe a
Just (Double -> LlvmType -> LlvmLit
LMFloatLit Double
12345678.9 LlvmType
t)
garbageLit t :: LlvmType
t@(LMPointer LlvmType
_) = forall a. a -> Maybe a
Just (LlvmType -> LlvmLit
LMNullLit LlvmType
t)
garbageLit LlvmType
_ = forall a. Maybe a
Nothing
getVarType :: LlvmVar -> LlvmType
getVarType :: LlvmVar -> LlvmType
getVarType (LMGlobalVar FastString
_ LlvmType
y LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) = LlvmType
y
getVarType (LMLocalVar Unique
_ LlvmType
y ) = LlvmType
y
getVarType (LMNLocalVar FastString
_ LlvmType
y ) = LlvmType
y
getVarType (LMLitVar LlvmLit
l ) = LlvmLit -> LlvmType
getLitType LlvmLit
l
getLitType :: LlvmLit -> LlvmType
getLitType :: LlvmLit -> LlvmType
getLitType (LMIntLit Integer
_ LlvmType
t) = LlvmType
t
getLitType (LMFloatLit Double
_ LlvmType
t) = LlvmType
t
getLitType (LMVectorLit []) = forall a. String -> a
panic String
"getLitType"
getLitType (LMVectorLit [LlvmLit]
ls) = Int -> LlvmType -> LlvmType
LMVector (forall (t :: * -> *) a. Foldable t => t a -> Int
length [LlvmLit]
ls) (LlvmLit -> LlvmType
getLitType (forall a. [a] -> a
head [LlvmLit]
ls))
getLitType (LMNullLit LlvmType
t) = LlvmType
t
getLitType (LMUndefLit LlvmType
t) = LlvmType
t
getStatType :: LlvmStatic -> LlvmType
getStatType :: LlvmStatic -> LlvmType
getStatType (LMStaticLit LlvmLit
l ) = LlvmLit -> LlvmType
getLitType LlvmLit
l
getStatType (LMUninitType LlvmType
t) = LlvmType
t
getStatType (LMStaticStr FastString
_ LlvmType
t) = LlvmType
t
getStatType (LMStaticArray [LlvmStatic]
_ LlvmType
t) = LlvmType
t
getStatType (LMStaticStruc [LlvmStatic]
_ LlvmType
t) = LlvmType
t
getStatType (LMStaticPointer LlvmVar
v) = LlvmVar -> LlvmType
getVarType LlvmVar
v
getStatType (LMTrunc LlvmStatic
_ LlvmType
t) = LlvmType
t
getStatType (LMBitc LlvmStatic
_ LlvmType
t) = LlvmType
t
getStatType (LMPtoI LlvmStatic
_ LlvmType
t) = LlvmType
t
getStatType (LMAdd LlvmStatic
t LlvmStatic
_) = LlvmStatic -> LlvmType
getStatType LlvmStatic
t
getStatType (LMSub LlvmStatic
t LlvmStatic
_) = LlvmStatic -> LlvmType
getStatType LlvmStatic
t
getStatType (LMComment FastString
_) = forall a. HasCallStack => String -> a
error String
"Can't call getStatType on LMComment!"
getLink :: LlvmVar -> LlvmLinkageType
getLink :: LlvmVar -> LlvmLinkageType
getLink (LMGlobalVar FastString
_ LlvmType
_ LlvmLinkageType
l LMSection
_ LMAlign
_ LMConst
_) = LlvmLinkageType
l
getLink LlvmVar
_ = LlvmLinkageType
Internal
pLift :: LlvmType -> LlvmType
pLift :: LlvmType -> LlvmType
pLift LlvmType
LMLabel = forall a. HasCallStack => String -> a
error String
"Labels are unliftable"
pLift LlvmType
LMVoid = forall a. HasCallStack => String -> a
error String
"Voids are unliftable"
pLift LlvmType
LMMetadata = forall a. HasCallStack => String -> a
error String
"Metadatas are unliftable"
pLift LlvmType
x = LlvmType -> LlvmType
LMPointer LlvmType
x
pVarLift :: LlvmVar -> LlvmVar
pVarLift :: LlvmVar -> LlvmVar
pVarLift (LMGlobalVar FastString
s LlvmType
t LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c) = FastString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar FastString
s (LlvmType -> LlvmType
pLift LlvmType
t) LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c
pVarLift (LMLocalVar Unique
s LlvmType
t ) = Unique -> LlvmType -> LlvmVar
LMLocalVar Unique
s (LlvmType -> LlvmType
pLift LlvmType
t)
pVarLift (LMNLocalVar FastString
s LlvmType
t ) = FastString -> LlvmType -> LlvmVar
LMNLocalVar FastString
s (LlvmType -> LlvmType
pLift LlvmType
t)
pVarLift (LMLitVar LlvmLit
_ ) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't lower a literal type!"
pLower :: LlvmType -> LlvmType
pLower :: LlvmType -> LlvmType
pLower (LMPointer LlvmType
x) = LlvmType
x
pLower LlvmType
x = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"llvmGen(pLower)"
forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr LlvmType
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" is a unlowerable type, need a pointer"
pVarLower :: LlvmVar -> LlvmVar
pVarLower :: LlvmVar -> LlvmVar
pVarLower (LMGlobalVar FastString
s LlvmType
t LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c) = FastString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar FastString
s (LlvmType -> LlvmType
pLower LlvmType
t) LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c
pVarLower (LMLocalVar Unique
s LlvmType
t ) = Unique -> LlvmType -> LlvmVar
LMLocalVar Unique
s (LlvmType -> LlvmType
pLower LlvmType
t)
pVarLower (LMNLocalVar FastString
s LlvmType
t ) = FastString -> LlvmType -> LlvmVar
LMNLocalVar FastString
s (LlvmType -> LlvmType
pLower LlvmType
t)
pVarLower (LMLitVar LlvmLit
_ ) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't lower a literal type!"
isInt :: LlvmType -> Bool
isInt :: LlvmType -> Bool
isInt (LMInt Int
_) = Bool
True
isInt LlvmType
_ = Bool
False
isFloat :: LlvmType -> Bool
isFloat :: LlvmType -> Bool
isFloat LlvmType
LMFloat = Bool
True
isFloat LlvmType
LMDouble = Bool
True
isFloat LlvmType
LMFloat80 = Bool
True
isFloat LlvmType
LMFloat128 = Bool
True
isFloat LlvmType
_ = Bool
False
isPointer :: LlvmType -> Bool
isPointer :: LlvmType -> Bool
isPointer (LMPointer LlvmType
_) = Bool
True
isPointer LlvmType
_ = Bool
False
isVector :: LlvmType -> Bool
isVector :: LlvmType -> Bool
isVector (LMVector {}) = Bool
True
isVector LlvmType
_ = Bool
False
isGlobal :: LlvmVar -> Bool
isGlobal :: LlvmVar -> Bool
isGlobal (LMGlobalVar FastString
_ LlvmType
_ LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) = Bool
True
isGlobal LlvmVar
_ = Bool
False
llvmWidthInBits :: Platform -> LlvmType -> Int
llvmWidthInBits :: Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform = \case
(LMInt Int
n) -> Int
n
(LlvmType
LMFloat) -> Int
32
(LlvmType
LMDouble) -> Int
64
(LlvmType
LMFloat80) -> Int
80
(LlvmType
LMFloat128) -> Int
128
(LMPointer LlvmType
_) -> Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform (Platform -> LlvmType
llvmWord Platform
platform)
(LMArray Int
n LlvmType
t) -> Int
n forall a. Num a => a -> a -> a
* Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform LlvmType
t
(LMVector Int
n LlvmType
ty) -> Int
n forall a. Num a => a -> a -> a
* Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform LlvmType
ty
LlvmType
LMLabel -> Int
0
LlvmType
LMVoid -> Int
0
(LMStruct [LlvmType]
tys) -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform) [LlvmType]
tys
(LMStructU [LlvmType]
_) ->
forall a. String -> a
panic String
"llvmWidthInBits: not implemented for LMStructU"
(LMFunction LlvmFunctionDecl
_) -> Int
0
(LMAlias (FastString
_,LlvmType
t)) -> Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform LlvmType
t
LlvmType
LMMetadata -> forall a. String -> a
panic String
"llvmWidthInBits: Meta-data has no runtime representation!"
i128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType
i128 :: LlvmType
i128 = Int -> LlvmType
LMInt Int
128
i64 :: LlvmType
i64 = Int -> LlvmType
LMInt Int
64
i32 :: LlvmType
i32 = Int -> LlvmType
LMInt Int
32
i16 :: LlvmType
i16 = Int -> LlvmType
LMInt Int
16
i8 :: LlvmType
i8 = Int -> LlvmType
LMInt Int
8
i1 :: LlvmType
i1 = Int -> LlvmType
LMInt Int
1
i8Ptr :: LlvmType
i8Ptr = LlvmType -> LlvmType
pLift LlvmType
i8
llvmWord, llvmWordPtr :: Platform -> LlvmType
llvmWord :: Platform -> LlvmType
llvmWord Platform
platform = Int -> LlvmType
LMInt (Platform -> Int
platformWordSizeInBytes Platform
platform forall a. Num a => a -> a -> a
* Int
8)
llvmWordPtr :: Platform -> LlvmType
llvmWordPtr Platform
platform = LlvmType -> LlvmType
pLift (Platform -> LlvmType
llvmWord Platform
platform)
data LlvmFunctionDecl = LlvmFunctionDecl {
LlvmFunctionDecl -> FastString
decName :: LMString,
LlvmFunctionDecl -> LlvmLinkageType
funcLinkage :: LlvmLinkageType,
LlvmFunctionDecl -> LlvmCallConvention
funcCc :: LlvmCallConvention,
LlvmFunctionDecl -> LlvmType
decReturnType :: LlvmType,
LlvmFunctionDecl -> LlvmParameterListType
decVarargs :: LlvmParameterListType,
LlvmFunctionDecl -> [LlvmParameter]
decParams :: [LlvmParameter],
LlvmFunctionDecl -> LMAlign
funcAlign :: LMAlign
}
deriving (LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
$c/= :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
== :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
$c== :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
Eq)
instance Outputable LlvmFunctionDecl where
ppr :: LlvmFunctionDecl -> SDoc
ppr (LlvmFunctionDecl FastString
n LlvmLinkageType
l LlvmCallConvention
c LlvmType
r LlvmParameterListType
varg [LlvmParameter]
p LMAlign
a)
= let align :: SDoc
align = case LMAlign
a of
Just Int
a' -> String -> SDoc
text String
" align " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> SDoc
empty
in forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LlvmType
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext FastString
n SDoc -> SDoc -> SDoc
<>
SDoc
lparen SDoc -> SDoc -> SDoc
<> LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams LlvmParameterListType
varg [LlvmParameter]
p SDoc -> SDoc -> SDoc
<> SDoc
rparen SDoc -> SDoc -> SDoc
<> SDoc
align
type LlvmFunctionDecls = [LlvmFunctionDecl]
type LlvmParameter = (LlvmType, [LlvmParamAttr])
data LlvmParamAttr
= ZeroExt
| SignExt
| InReg
| ByVal
| SRet
| NoAlias
| NoCapture
| Nest
deriving (LlvmParamAttr -> LlvmParamAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmParamAttr -> LlvmParamAttr -> Bool
$c/= :: LlvmParamAttr -> LlvmParamAttr -> Bool
== :: LlvmParamAttr -> LlvmParamAttr -> Bool
$c== :: LlvmParamAttr -> LlvmParamAttr -> Bool
Eq)
instance Outputable LlvmParamAttr where
ppr :: LlvmParamAttr -> SDoc
ppr LlvmParamAttr
ZeroExt = String -> SDoc
text String
"zeroext"
ppr LlvmParamAttr
SignExt = String -> SDoc
text String
"signext"
ppr LlvmParamAttr
InReg = String -> SDoc
text String
"inreg"
ppr LlvmParamAttr
ByVal = String -> SDoc
text String
"byval"
ppr LlvmParamAttr
SRet = String -> SDoc
text String
"sret"
ppr LlvmParamAttr
NoAlias = String -> SDoc
text String
"noalias"
ppr LlvmParamAttr
NoCapture = String -> SDoc
text String
"nocapture"
ppr LlvmParamAttr
Nest = String -> SDoc
text String
"nest"
data LlvmFuncAttr
= AlwaysInline
| InlineHint
| NoInline
| OptSize
| NoReturn
| NoUnwind
| ReadNone
| ReadOnly
| Ssp
| SspReq
| NoRedZone
| NoImplicitFloat
| Naked
deriving (LlvmFuncAttr -> LlvmFuncAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
$c/= :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
== :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
$c== :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
Eq)
instance Outputable LlvmFuncAttr where
ppr :: LlvmFuncAttr -> SDoc
ppr LlvmFuncAttr
AlwaysInline = String -> SDoc
text String
"alwaysinline"
ppr LlvmFuncAttr
InlineHint = String -> SDoc
text String
"inlinehint"
ppr LlvmFuncAttr
NoInline = String -> SDoc
text String
"noinline"
ppr LlvmFuncAttr
OptSize = String -> SDoc
text String
"optsize"
ppr LlvmFuncAttr
NoReturn = String -> SDoc
text String
"noreturn"
ppr LlvmFuncAttr
NoUnwind = String -> SDoc
text String
"nounwind"
ppr LlvmFuncAttr
ReadNone = String -> SDoc
text String
"readnone"
ppr LlvmFuncAttr
ReadOnly = String -> SDoc
text String
"readonly"
ppr LlvmFuncAttr
Ssp = String -> SDoc
text String
"ssp"
ppr LlvmFuncAttr
SspReq = String -> SDoc
text String
"ssqreq"
ppr LlvmFuncAttr
NoRedZone = String -> SDoc
text String
"noredzone"
ppr LlvmFuncAttr
NoImplicitFloat = String -> SDoc
text String
"noimplicitfloat"
ppr LlvmFuncAttr
Naked = String -> SDoc
text String
"naked"
data LlvmCallType
= StdCall
| TailCall
deriving (LlvmCallType -> LlvmCallType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmCallType -> LlvmCallType -> Bool
$c/= :: LlvmCallType -> LlvmCallType -> Bool
== :: LlvmCallType -> LlvmCallType -> Bool
$c== :: LlvmCallType -> LlvmCallType -> Bool
Eq,Int -> LlvmCallType -> ShowS
[LlvmCallType] -> ShowS
LlvmCallType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LlvmCallType] -> ShowS
$cshowList :: [LlvmCallType] -> ShowS
show :: LlvmCallType -> String
$cshow :: LlvmCallType -> String
showsPrec :: Int -> LlvmCallType -> ShowS
$cshowsPrec :: Int -> LlvmCallType -> ShowS
Show)
data LlvmCallConvention
= CC_Ccc
| CC_Fastcc
| CC_Coldcc
| CC_Ghc
| CC_Ncc Int
| CC_X86_Stdcc
deriving (LlvmCallConvention -> LlvmCallConvention -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmCallConvention -> LlvmCallConvention -> Bool
$c/= :: LlvmCallConvention -> LlvmCallConvention -> Bool
== :: LlvmCallConvention -> LlvmCallConvention -> Bool
$c== :: LlvmCallConvention -> LlvmCallConvention -> Bool
Eq)
instance Outputable LlvmCallConvention where
ppr :: LlvmCallConvention -> SDoc
ppr LlvmCallConvention
CC_Ccc = String -> SDoc
text String
"ccc"
ppr LlvmCallConvention
CC_Fastcc = String -> SDoc
text String
"fastcc"
ppr LlvmCallConvention
CC_Coldcc = String -> SDoc
text String
"coldcc"
ppr LlvmCallConvention
CC_Ghc = String -> SDoc
text String
"ghccc"
ppr (CC_Ncc Int
i) = String -> SDoc
text String
"cc " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Int
i
ppr LlvmCallConvention
CC_X86_Stdcc = String -> SDoc
text String
"x86_stdcallcc"
data LlvmParameterListType
= FixedArgs
| VarArgs
deriving (LlvmParameterListType -> LlvmParameterListType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmParameterListType -> LlvmParameterListType -> Bool
$c/= :: LlvmParameterListType -> LlvmParameterListType -> Bool
== :: LlvmParameterListType -> LlvmParameterListType -> Bool
$c== :: LlvmParameterListType -> LlvmParameterListType -> Bool
Eq,Int -> LlvmParameterListType -> ShowS
[LlvmParameterListType] -> ShowS
LlvmParameterListType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LlvmParameterListType] -> ShowS
$cshowList :: [LlvmParameterListType] -> ShowS
show :: LlvmParameterListType -> String
$cshow :: LlvmParameterListType -> String
showsPrec :: Int -> LlvmParameterListType -> ShowS
$cshowsPrec :: Int -> LlvmParameterListType -> ShowS
Show)
data LlvmLinkageType
= Internal
| LinkOnce
| Weak
| Appending
| ExternWeak
| ExternallyVisible
| External
| Private
deriving (LlvmLinkageType -> LlvmLinkageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmLinkageType -> LlvmLinkageType -> Bool
$c/= :: LlvmLinkageType -> LlvmLinkageType -> Bool
== :: LlvmLinkageType -> LlvmLinkageType -> Bool
$c== :: LlvmLinkageType -> LlvmLinkageType -> Bool
Eq)
instance Outputable LlvmLinkageType where
ppr :: LlvmLinkageType -> SDoc
ppr LlvmLinkageType
Internal = String -> SDoc
text String
"internal"
ppr LlvmLinkageType
LinkOnce = String -> SDoc
text String
"linkonce"
ppr LlvmLinkageType
Weak = String -> SDoc
text String
"weak"
ppr LlvmLinkageType
Appending = String -> SDoc
text String
"appending"
ppr LlvmLinkageType
ExternWeak = String -> SDoc
text String
"extern_weak"
ppr LlvmLinkageType
ExternallyVisible = SDoc
empty
ppr LlvmLinkageType
External = String -> SDoc
text String
"external"
ppr LlvmLinkageType
Private = String -> SDoc
text String
"private"
data LlvmMachOp
= LM_MO_Add
| LM_MO_Sub
| LM_MO_Mul
| LM_MO_UDiv
| LM_MO_SDiv
| LM_MO_URem
| LM_MO_SRem
| LM_MO_FAdd
| LM_MO_FSub
| LM_MO_FMul
| LM_MO_FDiv
| LM_MO_FRem
| LM_MO_Shl
| LM_MO_LShr
| LM_MO_AShr
| LM_MO_And
| LM_MO_Or
| LM_MO_Xor
deriving (LlvmMachOp -> LlvmMachOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmMachOp -> LlvmMachOp -> Bool
$c/= :: LlvmMachOp -> LlvmMachOp -> Bool
== :: LlvmMachOp -> LlvmMachOp -> Bool
$c== :: LlvmMachOp -> LlvmMachOp -> Bool
Eq)
instance Outputable LlvmMachOp where
ppr :: LlvmMachOp -> SDoc
ppr LlvmMachOp
LM_MO_Add = String -> SDoc
text String
"add"
ppr LlvmMachOp
LM_MO_Sub = String -> SDoc
text String
"sub"
ppr LlvmMachOp
LM_MO_Mul = String -> SDoc
text String
"mul"
ppr LlvmMachOp
LM_MO_UDiv = String -> SDoc
text String
"udiv"
ppr LlvmMachOp
LM_MO_SDiv = String -> SDoc
text String
"sdiv"
ppr LlvmMachOp
LM_MO_URem = String -> SDoc
text String
"urem"
ppr LlvmMachOp
LM_MO_SRem = String -> SDoc
text String
"srem"
ppr LlvmMachOp
LM_MO_FAdd = String -> SDoc
text String
"fadd"
ppr LlvmMachOp
LM_MO_FSub = String -> SDoc
text String
"fsub"
ppr LlvmMachOp
LM_MO_FMul = String -> SDoc
text String
"fmul"
ppr LlvmMachOp
LM_MO_FDiv = String -> SDoc
text String
"fdiv"
ppr LlvmMachOp
LM_MO_FRem = String -> SDoc
text String
"frem"
ppr LlvmMachOp
LM_MO_Shl = String -> SDoc
text String
"shl"
ppr LlvmMachOp
LM_MO_LShr = String -> SDoc
text String
"lshr"
ppr LlvmMachOp
LM_MO_AShr = String -> SDoc
text String
"ashr"
ppr LlvmMachOp
LM_MO_And = String -> SDoc
text String
"and"
ppr LlvmMachOp
LM_MO_Or = String -> SDoc
text String
"or"
ppr LlvmMachOp
LM_MO_Xor = String -> SDoc
text String
"xor"
data LlvmCmpOp
= LM_CMP_Eq
| LM_CMP_Ne
| LM_CMP_Ugt
| LM_CMP_Uge
| LM_CMP_Ult
| LM_CMP_Ule
| LM_CMP_Sgt
| LM_CMP_Sge
| LM_CMP_Slt
| LM_CMP_Sle
| LM_CMP_Feq
| LM_CMP_Fne
| LM_CMP_Fgt
| LM_CMP_Fge
| LM_CMP_Flt
| LM_CMP_Fle
deriving (LlvmCmpOp -> LlvmCmpOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmCmpOp -> LlvmCmpOp -> Bool
$c/= :: LlvmCmpOp -> LlvmCmpOp -> Bool
== :: LlvmCmpOp -> LlvmCmpOp -> Bool
$c== :: LlvmCmpOp -> LlvmCmpOp -> Bool
Eq)
instance Outputable LlvmCmpOp where
ppr :: LlvmCmpOp -> SDoc
ppr LlvmCmpOp
LM_CMP_Eq = String -> SDoc
text String
"eq"
ppr LlvmCmpOp
LM_CMP_Ne = String -> SDoc
text String
"ne"
ppr LlvmCmpOp
LM_CMP_Ugt = String -> SDoc
text String
"ugt"
ppr LlvmCmpOp
LM_CMP_Uge = String -> SDoc
text String
"uge"
ppr LlvmCmpOp
LM_CMP_Ult = String -> SDoc
text String
"ult"
ppr LlvmCmpOp
LM_CMP_Ule = String -> SDoc
text String
"ule"
ppr LlvmCmpOp
LM_CMP_Sgt = String -> SDoc
text String
"sgt"
ppr LlvmCmpOp
LM_CMP_Sge = String -> SDoc
text String
"sge"
ppr LlvmCmpOp
LM_CMP_Slt = String -> SDoc
text String
"slt"
ppr LlvmCmpOp
LM_CMP_Sle = String -> SDoc
text String
"sle"
ppr LlvmCmpOp
LM_CMP_Feq = String -> SDoc
text String
"oeq"
ppr LlvmCmpOp
LM_CMP_Fne = String -> SDoc
text String
"une"
ppr LlvmCmpOp
LM_CMP_Fgt = String -> SDoc
text String
"ogt"
ppr LlvmCmpOp
LM_CMP_Fge = String -> SDoc
text String
"oge"
ppr LlvmCmpOp
LM_CMP_Flt = String -> SDoc
text String
"olt"
ppr LlvmCmpOp
LM_CMP_Fle = String -> SDoc
text String
"ole"
data LlvmCastOp
= LM_Trunc
| LM_Zext
| LM_Sext
| LM_Fptrunc
| LM_Fpext
| LM_Fptoui
| LM_Fptosi
| LM_Uitofp
| LM_Sitofp
| LM_Ptrtoint
| LM_Inttoptr
| LM_Bitcast
deriving (LlvmCastOp -> LlvmCastOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LlvmCastOp -> LlvmCastOp -> Bool
$c/= :: LlvmCastOp -> LlvmCastOp -> Bool
== :: LlvmCastOp -> LlvmCastOp -> Bool
$c== :: LlvmCastOp -> LlvmCastOp -> Bool
Eq)
instance Outputable LlvmCastOp where
ppr :: LlvmCastOp -> SDoc
ppr LlvmCastOp
LM_Trunc = String -> SDoc
text String
"trunc"
ppr LlvmCastOp
LM_Zext = String -> SDoc
text String
"zext"
ppr LlvmCastOp
LM_Sext = String -> SDoc
text String
"sext"
ppr LlvmCastOp
LM_Fptrunc = String -> SDoc
text String
"fptrunc"
ppr LlvmCastOp
LM_Fpext = String -> SDoc
text String
"fpext"
ppr LlvmCastOp
LM_Fptoui = String -> SDoc
text String
"fptoui"
ppr LlvmCastOp
LM_Fptosi = String -> SDoc
text String
"fptosi"
ppr LlvmCastOp
LM_Uitofp = String -> SDoc
text String
"uitofp"
ppr LlvmCastOp
LM_Sitofp = String -> SDoc
text String
"sitofp"
ppr LlvmCastOp
LM_Ptrtoint = String -> SDoc
text String
"ptrtoint"
ppr LlvmCastOp
LM_Inttoptr = String -> SDoc
text String
"inttoptr"
ppr LlvmCastOp
LM_Bitcast = String -> SDoc
text String
"bitcast"
ppDouble :: Platform -> Double -> SDoc
ppDouble :: Platform -> Double -> SDoc
ppDouble Platform
platform Double
d
= let bs :: [Int]
bs = Double -> [Int]
doubleToBytes Double
d
hex :: a -> String
hex a
d' = case forall a. (Integral a, Show a) => a -> ShowS
showHex a
d' String
"" of
[] -> forall a. HasCallStack => String -> a
error String
"ppDouble: too few hex digits for float"
[Char
x] -> [Char
'0',Char
x]
[Char
x,Char
y] -> [Char
x,Char
y]
String
_ -> forall a. HasCallStack => String -> a
error String
"ppDouble: too many hex digits for float"
fixEndian :: [String] -> [String]
fixEndian = case Platform -> ByteOrder
platformByteOrder Platform
platform of
ByteOrder
BigEndian -> forall a. a -> a
id
ByteOrder
LittleEndian -> forall a. [a] -> [a]
reverse
str :: String
str = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [String] -> [String]
fixEndian forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Integral a, Show a) => a -> String
hex [Int]
bs
in String -> SDoc
text String
"0x" SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
str
narrowFp :: Double -> Float
{-# NOINLINE narrowFp #-}
narrowFp :: Double -> Float
narrowFp = Double -> Float
double2Float
widenFp :: Float -> Double
{-# NOINLINE widenFp #-}
widenFp :: Float -> Double
widenFp = Float -> Double
float2Double
ppFloat :: Platform -> Float -> SDoc
ppFloat :: Platform -> Float -> SDoc
ppFloat Platform
platform = Platform -> Double -> SDoc
ppDouble Platform
platform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
widenFp
ppCommaJoin :: (Outputable a) => [a] -> SDoc
ppCommaJoin :: forall a. Outputable a => [a] -> SDoc
ppCommaJoin [a]
strs = [SDoc] -> SDoc
hsep forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [a]
strs)
ppSpaceJoin :: (Outputable a) => [a] -> SDoc
ppSpaceJoin :: forall a. Outputable a => [a] -> SDoc
ppSpaceJoin [a]
strs = [SDoc] -> SDoc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [a]
strs)