{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
module Llvm.Types where
#include "HsVersions.h"
import GhcPrelude
import Data.Char
import Data.Int
import Numeric
import DynFlags
import FastString
import Outputable
import Unique
import PprBase
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
(LlvmType -> LlvmType -> Bool)
-> (LlvmType -> LlvmType -> Bool) -> Eq LlvmType
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 (LMInt Int
size ) = Char -> SDoc
char Char
'i' SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
size
ppr (LlvmType
LMFloat ) = String -> SDoc
text String
"float"
ppr (LlvmType
LMDouble ) = String -> SDoc
text String
"double"
ppr (LlvmType
LMFloat80 ) = String -> SDoc
text String
"x86_fp80"
ppr (LlvmType
LMFloat128 ) = String -> SDoc
text String
"fp128"
ppr (LMPointer LlvmType
x ) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
x SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'*'
ppr (LMArray Int
nr LlvmType
tp ) = Char -> SDoc
char Char
'[' SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nr SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" x " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
']'
ppr (LMVector Int
nr LlvmType
tp ) = Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nr SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" x " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
tp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'>'
ppr (LlvmType
LMLabel ) = String -> SDoc
text String
"label"
ppr (LlvmType
LMVoid ) = String -> SDoc
text String
"void"
ppr (LMStruct [LlvmType]
tys ) = String -> SDoc
text String
"<{" SDoc -> SDoc -> SDoc
<> [LlvmType] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmType]
tys SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"}>"
ppr (LMStructU [LlvmType]
tys ) = String -> SDoc
text String
"{" SDoc -> SDoc -> SDoc
<> [LlvmType] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmType]
tys SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"}"
ppr (LlvmType
LMMetadata ) = String -> SDoc
text String
"metadata"
ppr (LMFunction (LlvmFunctionDecl LMString
_ LlvmLinkageType
_ LlvmCallConvention
_ LlvmType
r LlvmParameterListType
varg [LlvmParameter]
p LMAlign
_))
= LlvmType -> SDoc
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
ppr (LMAlias (LMString
s,LlvmType
_)) = Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
s
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams LlvmParameterListType
varg [LlvmParameter]
p
= let varg' :: PtrString
varg' = case LlvmParameterListType
varg of
LlvmParameterListType
VarArgs | [LlvmType] -> Bool
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 = (LlvmParameter -> LlvmType) -> [LlvmParameter] -> [LlvmType]
forall a b. (a -> b) -> [a] -> [b]
map LlvmParameter -> LlvmType
forall a b. (a, b) -> a
fst [LlvmParameter]
p
in [LlvmType] -> SDoc
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
(LMConst -> LMConst -> Bool)
-> (LMConst -> LMConst -> Bool) -> Eq LMConst
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
(LlvmVar -> LlvmVar -> Bool)
-> (LlvmVar -> LlvmVar -> Bool) -> Eq LlvmVar
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)
instance Outputable LlvmVar where
ppr :: LlvmVar -> SDoc
ppr (LMLitVar LlvmLit
x) = LlvmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLit
x
ppr (LlvmVar
x ) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmVar -> LlvmType
getVarType LlvmVar
x) SDoc -> SDoc -> SDoc
<+> LlvmVar -> SDoc
ppName LlvmVar
x
data LlvmLit
= LMIntLit Integer LlvmType
| LMFloatLit Double LlvmType
| LMNullLit LlvmType
| LMVectorLit [LlvmLit]
| LMUndefLit LlvmType
deriving (LlvmLit -> LlvmLit -> Bool
(LlvmLit -> LlvmLit -> Bool)
-> (LlvmLit -> LlvmLit -> Bool) -> Eq LlvmLit
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)
instance Outputable LlvmLit where
ppr :: LlvmLit -> SDoc
ppr l :: LlvmLit
l@(LMVectorLit {}) = LlvmLit -> SDoc
ppLit LlvmLit
l
ppr LlvmLit
l = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmLit -> LlvmType
getLitType LlvmLit
l) SDoc -> SDoc -> SDoc
<+> LlvmLit -> SDoc
ppLit LlvmLit
l
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
instance Outputable LlvmStatic where
ppr :: LlvmStatic -> SDoc
ppr (LMComment LMString
s) = String -> SDoc
text String
"; " SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
s
ppr (LMStaticLit LlvmLit
l ) = LlvmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLit
l
ppr (LMUninitType LlvmType
t) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" undef"
ppr (LMStaticStr LMString
s LlvmType
t) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" c\"" SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
s SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"\\00\""
ppr (LMStaticArray [LlvmStatic]
d LlvmType
t) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" [" SDoc -> SDoc -> SDoc
<> [LlvmStatic] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmStatic]
d SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
']'
ppr (LMStaticStruc [LlvmStatic]
d LlvmType
t) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"<{" SDoc -> SDoc -> SDoc
<> [LlvmStatic] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmStatic]
d SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"}>"
ppr (LMStaticPointer LlvmVar
v) = LlvmVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmVar
v
ppr (LMTrunc LlvmStatic
v LlvmType
t)
= LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" trunc (" SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" to " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
ppr (LMBitc LlvmStatic
v LlvmType
t)
= LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" bitcast (" SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" to " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
ppr (LMPtoI LlvmStatic
v LlvmType
t)
= LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" ptrtoint (" SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" to " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
ppr (LMAdd LlvmStatic
s1 LlvmStatic
s2)
= LlvmStatic
-> LlvmStatic -> PtrString -> PtrString -> String -> SDoc
pprStaticArith LlvmStatic
s1 LlvmStatic
s2 (String -> PtrString
sLit String
"add") (String -> PtrString
sLit String
"fadd") String
"LMAdd"
ppr (LMSub LlvmStatic
s1 LlvmStatic
s2)
= LlvmStatic
-> LlvmStatic -> PtrString -> PtrString -> String -> SDoc
pprStaticArith LlvmStatic
s1 LlvmStatic
s2 (String -> PtrString
sLit String
"sub") (String -> PtrString
sLit String
"fsub") String
"LMSub"
pprSpecialStatic :: LlvmStatic -> SDoc
pprSpecialStatic :: LlvmStatic -> SDoc
pprSpecialStatic (LMBitc LlvmStatic
v LlvmType
t) =
LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower LlvmType
t) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
", bitcast (" SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" to " SDoc -> SDoc -> SDoc
<> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
t
SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
pprSpecialStatic v :: LlvmStatic
v@(LMStaticPointer LlvmVar
x) = LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LlvmType -> LlvmType
pLower (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LlvmVar -> LlvmType
getVarType LlvmVar
x) SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
v
pprSpecialStatic LlvmStatic
stat = LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
stat
pprStaticArith :: LlvmStatic -> LlvmStatic -> PtrString -> PtrString
-> String -> SDoc
pprStaticArith :: LlvmStatic
-> LlvmStatic -> PtrString -> PtrString -> String -> SDoc
pprStaticArith LlvmStatic
s1 LlvmStatic
s2 PtrString
int_op PtrString
float_op String
op_name =
let ty1 :: LlvmType
ty1 = LlvmStatic -> LlvmType
getStatType LlvmStatic
s1
op :: PtrString
op = if LlvmType -> Bool
isFloat LlvmType
ty1 then PtrString
float_op else PtrString
int_op
in if LlvmType
ty1 LlvmType -> LlvmType -> Bool
forall a. Eq a => a -> a -> Bool
== LlvmStatic -> LlvmType
getStatType LlvmStatic
s2
then LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
ty1 SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext PtrString
op SDoc -> SDoc -> SDoc
<+> SDoc
lparen SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
s1 SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
s2 SDoc -> SDoc -> SDoc
<> SDoc
rparen
else (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
String -> SDoc
forall a. HasCallStack => String -> a
error (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
op_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with different types! s1: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
s1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", s2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (LlvmStatic -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmStatic
s2)
ppName :: LlvmVar -> SDoc
ppName :: LlvmVar -> SDoc
ppName v :: LlvmVar
v@(LMGlobalVar {}) = Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> LlvmVar -> SDoc
ppPlainName LlvmVar
v
ppName v :: LlvmVar
v@(LMLocalVar {}) = Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> LlvmVar -> SDoc
ppPlainName LlvmVar
v
ppName v :: LlvmVar
v@(LMNLocalVar {}) = Char -> SDoc
char Char
'%' SDoc -> SDoc -> SDoc
<> LlvmVar -> SDoc
ppPlainName LlvmVar
v
ppName v :: LlvmVar
v@(LMLitVar {}) = LlvmVar -> SDoc
ppPlainName LlvmVar
v
ppPlainName :: LlvmVar -> SDoc
ppPlainName :: LlvmVar -> SDoc
ppPlainName (LMGlobalVar LMString
x LlvmType
_ LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) = LMString -> SDoc
ftext LMString
x
ppPlainName (LMLocalVar Unique
x LlvmType
LMLabel ) = String -> SDoc
text (Unique -> String
forall a. Show a => a -> String
show Unique
x)
ppPlainName (LMLocalVar Unique
x LlvmType
_ ) = String -> SDoc
text (Char
'l' Char -> String -> String
forall a. a -> [a] -> [a]
: Unique -> String
forall a. Show a => a -> String
show Unique
x)
ppPlainName (LMNLocalVar LMString
x LlvmType
_ ) = LMString -> SDoc
ftext LMString
x
ppPlainName (LMLitVar LlvmLit
x ) = LlvmLit -> SDoc
ppLit LlvmLit
x
ppLit :: LlvmLit -> SDoc
ppLit :: LlvmLit -> SDoc
ppLit (LMIntLit Integer
i (LMInt Int
32)) = Int32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Integer -> Int32
forall a. Num a => Integer -> a
fromInteger Integer
i :: Int32)
ppLit (LMIntLit Integer
i (LMInt Int
64)) = Int64 -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
i :: Int64)
ppLit (LMIntLit Integer
i LlvmType
_ ) = Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)::Int)
ppLit (LMFloatLit Double
r LlvmType
LMFloat ) = Float -> SDoc
ppFloat (Float -> SDoc) -> Float -> SDoc
forall a b. (a -> b) -> a -> b
$ Double -> Float
narrowFp Double
r
ppLit (LMFloatLit Double
r LlvmType
LMDouble) = Double -> SDoc
ppDouble Double
r
ppLit f :: LlvmLit
f@(LMFloatLit Double
_ LlvmType
_) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags (\DynFlags
dflags ->
String -> SDoc
forall a. HasCallStack => String -> a
error (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"Can't print this float literal!" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (LlvmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLit
f))
ppLit (LMVectorLit [LlvmLit]
ls ) = Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<+> [LlvmLit] -> SDoc
forall a. Outputable a => [a] -> SDoc
ppCommaJoin [LlvmLit]
ls SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'>'
ppLit (LMNullLit LlvmType
_ ) = String -> SDoc
text String
"null"
ppLit (LMUndefLit LlvmType
t ) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags DynFlags -> SDoc
f
where f :: DynFlags -> SDoc
f DynFlags
dflags
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LlvmFillUndefWithGarbage DynFlags
dflags,
Just LlvmLit
lit <- LlvmType -> Maybe LlvmLit
garbageLit LlvmType
t = LlvmLit -> SDoc
ppLit LlvmLit
lit
| Bool
otherwise = String -> SDoc
text String
"undef"
garbageLit :: LlvmType -> Maybe LlvmLit
garbageLit :: LlvmType -> Maybe LlvmLit
garbageLit t :: LlvmType
t@(LMInt Int
w) = LlvmLit -> Maybe LlvmLit
forall a. a -> Maybe a
Just (Integer -> LlvmType -> LlvmLit
LMIntLit (Integer
0xbbbbbbbbbbbbbbb0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
w)) LlvmType
t)
garbageLit LlvmType
t
| LlvmType -> Bool
isFloat LlvmType
t = LlvmLit -> Maybe LlvmLit
forall a. a -> Maybe a
Just (Double -> LlvmType -> LlvmLit
LMFloatLit Double
12345678.9 LlvmType
t)
garbageLit t :: LlvmType
t@(LMPointer LlvmType
_) = LlvmLit -> Maybe LlvmLit
forall a. a -> Maybe a
Just (LlvmType -> LlvmLit
LMNullLit LlvmType
t)
garbageLit LlvmType
_ = Maybe LlvmLit
forall a. Maybe a
Nothing
getVarType :: LlvmVar -> LlvmType
getVarType :: LlvmVar -> LlvmType
getVarType (LMGlobalVar LMString
_ LlvmType
y LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) = LlvmType
y
getVarType (LMLocalVar Unique
_ LlvmType
y ) = LlvmType
y
getVarType (LMNLocalVar LMString
_ 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 []) = String -> LlvmType
forall a. String -> a
panic String
"getLitType"
getLitType (LMVectorLit [LlvmLit]
ls) = Int -> LlvmType -> LlvmType
LMVector ([LlvmLit] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LlvmLit]
ls) (LlvmLit -> LlvmType
getLitType ([LlvmLit] -> LlvmLit
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 LMString
_ 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 LMString
_) = String -> LlvmType
forall a. HasCallStack => String -> a
error String
"Can't call getStatType on LMComment!"
getLink :: LlvmVar -> LlvmLinkageType
getLink :: LlvmVar -> LlvmLinkageType
getLink (LMGlobalVar LMString
_ LlvmType
_ LlvmLinkageType
l LMSection
_ LMAlign
_ LMConst
_) = LlvmLinkageType
l
getLink LlvmVar
_ = LlvmLinkageType
Internal
pLift :: LlvmType -> LlvmType
pLift :: LlvmType -> LlvmType
pLift LlvmType
LMLabel = String -> LlvmType
forall a. HasCallStack => String -> a
error String
"Labels are unliftable"
pLift LlvmType
LMVoid = String -> LlvmType
forall a. HasCallStack => String -> a
error String
"Voids are unliftable"
pLift LlvmType
LMMetadata = String -> LlvmType
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 LMString
s LlvmType
t LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c) = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
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 LMString
s LlvmType
t ) = LMString -> LlvmType -> LlvmVar
LMNLocalVar LMString
s (LlvmType -> LlvmType
pLift LlvmType
t)
pVarLift (LMLitVar LlvmLit
_ ) = String -> LlvmVar
forall a. HasCallStack => String -> a
error (String -> LlvmVar) -> String -> LlvmVar
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 = String -> SDoc -> LlvmType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"llvmGen(pLower)"
(SDoc -> LlvmType) -> SDoc -> LlvmType
forall a b. (a -> b) -> a -> b
$ LlvmType -> SDoc
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 LMString
s LlvmType
t LlvmLinkageType
l LMSection
x LMAlign
a LMConst
c) = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
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 LMString
s LlvmType
t ) = LMString -> LlvmType -> LlvmVar
LMNLocalVar LMString
s (LlvmType -> LlvmType
pLower LlvmType
t)
pVarLower (LMLitVar LlvmLit
_ ) = String -> LlvmVar
forall a. HasCallStack => String -> a
error (String -> LlvmVar) -> String -> LlvmVar
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 LMString
_ LlvmType
_ LlvmLinkageType
_ LMSection
_ LMAlign
_ LMConst
_) = Bool
True
isGlobal LlvmVar
_ = Bool
False
llvmWidthInBits :: DynFlags -> LlvmType -> Int
llvmWidthInBits :: DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
_ (LMInt Int
n) = Int
n
llvmWidthInBits DynFlags
_ (LlvmType
LMFloat) = Int
32
llvmWidthInBits DynFlags
_ (LlvmType
LMDouble) = Int
64
llvmWidthInBits DynFlags
_ (LlvmType
LMFloat80) = Int
80
llvmWidthInBits DynFlags
_ (LlvmType
LMFloat128) = Int
128
llvmWidthInBits DynFlags
dflags (LMPointer LlvmType
_) = DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags (DynFlags -> LlvmType
llvmWord DynFlags
dflags)
llvmWidthInBits DynFlags
dflags (LMArray Int
n LlvmType
t) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags LlvmType
t
llvmWidthInBits DynFlags
dflags (LMVector Int
n LlvmType
ty) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags LlvmType
ty
llvmWidthInBits DynFlags
_ LlvmType
LMLabel = Int
0
llvmWidthInBits DynFlags
_ LlvmType
LMVoid = Int
0
llvmWidthInBits DynFlags
dflags (LMStruct [LlvmType]
tys) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (LlvmType -> Int) -> [LlvmType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags) [LlvmType]
tys
llvmWidthInBits DynFlags
_ (LMStructU [LlvmType]
_) =
String -> Int
forall a. String -> a
panic String
"llvmWidthInBits: not implemented for LMStructU"
llvmWidthInBits DynFlags
_ (LMFunction LlvmFunctionDecl
_) = Int
0
llvmWidthInBits DynFlags
dflags (LMAlias (LMString
_,LlvmType
t)) = DynFlags -> LlvmType -> Int
llvmWidthInBits DynFlags
dflags LlvmType
t
llvmWidthInBits DynFlags
_ LlvmType
LMMetadata = String -> Int
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 :: DynFlags -> LlvmType
llvmWord :: DynFlags -> LlvmType
llvmWord DynFlags
dflags = Int -> LlvmType
LMInt (DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
llvmWordPtr :: DynFlags -> LlvmType
llvmWordPtr DynFlags
dflags = LlvmType -> LlvmType
pLift (DynFlags -> LlvmType
llvmWord DynFlags
dflags)
data LlvmFunctionDecl = LlvmFunctionDecl {
LlvmFunctionDecl -> LMString
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
(LlvmFunctionDecl -> LlvmFunctionDecl -> Bool)
-> (LlvmFunctionDecl -> LlvmFunctionDecl -> Bool)
-> Eq LlvmFunctionDecl
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 LMString
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
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
a'
LMAlign
Nothing -> SDoc
empty
in LlvmLinkageType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmLinkageType
l SDoc -> SDoc -> SDoc
<+> LlvmCallConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmCallConvention
c SDoc -> SDoc -> SDoc
<+> LlvmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr LlvmType
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> LMString -> SDoc
ftext LMString
n SDoc -> SDoc -> SDoc
<>
SDoc
lparen SDoc -> SDoc -> SDoc
<> 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
(LlvmParamAttr -> LlvmParamAttr -> Bool)
-> (LlvmParamAttr -> LlvmParamAttr -> Bool) -> Eq LlvmParamAttr
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
(LlvmFuncAttr -> LlvmFuncAttr -> Bool)
-> (LlvmFuncAttr -> LlvmFuncAttr -> Bool) -> Eq LlvmFuncAttr
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
"readnon"
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
(LlvmCallType -> LlvmCallType -> Bool)
-> (LlvmCallType -> LlvmCallType -> Bool) -> Eq LlvmCallType
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 -> String -> String
[LlvmCallType] -> String -> String
LlvmCallType -> String
(Int -> LlvmCallType -> String -> String)
-> (LlvmCallType -> String)
-> ([LlvmCallType] -> String -> String)
-> Show LlvmCallType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LlvmCallType] -> String -> String
$cshowList :: [LlvmCallType] -> String -> String
show :: LlvmCallType -> String
$cshow :: LlvmCallType -> String
showsPrec :: Int -> LlvmCallType -> String -> String
$cshowsPrec :: Int -> LlvmCallType -> String -> String
Show)
data LlvmCallConvention
= CC_Ccc
| CC_Fastcc
| CC_Coldcc
| CC_Ghc
| CC_Ncc Int
| CC_X86_Stdcc
deriving (LlvmCallConvention -> LlvmCallConvention -> Bool
(LlvmCallConvention -> LlvmCallConvention -> Bool)
-> (LlvmCallConvention -> LlvmCallConvention -> Bool)
-> Eq LlvmCallConvention
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
<> Int -> 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
(LlvmParameterListType -> LlvmParameterListType -> Bool)
-> (LlvmParameterListType -> LlvmParameterListType -> Bool)
-> Eq LlvmParameterListType
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 -> String -> String
[LlvmParameterListType] -> String -> String
LlvmParameterListType -> String
(Int -> LlvmParameterListType -> String -> String)
-> (LlvmParameterListType -> String)
-> ([LlvmParameterListType] -> String -> String)
-> Show LlvmParameterListType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LlvmParameterListType] -> String -> String
$cshowList :: [LlvmParameterListType] -> String -> String
show :: LlvmParameterListType -> String
$cshow :: LlvmParameterListType -> String
showsPrec :: Int -> LlvmParameterListType -> String -> String
$cshowsPrec :: Int -> LlvmParameterListType -> String -> String
Show)
data LlvmLinkageType
= Internal
| LinkOnce
| Weak
| Appending
| ExternWeak
| ExternallyVisible
| External
| Private
deriving (LlvmLinkageType -> LlvmLinkageType -> Bool
(LlvmLinkageType -> LlvmLinkageType -> Bool)
-> (LlvmLinkageType -> LlvmLinkageType -> Bool)
-> Eq LlvmLinkageType
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
(LlvmMachOp -> LlvmMachOp -> Bool)
-> (LlvmMachOp -> LlvmMachOp -> Bool) -> Eq LlvmMachOp
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
(LlvmCmpOp -> LlvmCmpOp -> Bool)
-> (LlvmCmpOp -> LlvmCmpOp -> Bool) -> Eq LlvmCmpOp
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
(LlvmCastOp -> LlvmCastOp -> Bool)
-> (LlvmCastOp -> LlvmCastOp -> Bool) -> Eq LlvmCastOp
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 :: Double -> SDoc
ppDouble :: Double -> SDoc
ppDouble Double
d
= let bs :: [Int]
bs = Double -> [Int]
doubleToBytes Double
d
hex :: a -> String
hex a
d' = case a -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex a
d' String
"" of
[] -> String -> String
forall a. HasCallStack => String -> a
error String
"dToStr: too few hex digits for float"
[Char
x] -> [Char
'0',Char
x]
[Char
x,Char
y] -> [Char
x,Char
y]
String
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"dToStr: too many hex digits for float"
in (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags (\DynFlags
dflags ->
let fixEndian :: [a] -> [a]
fixEndian = if DynFlags -> Bool
wORDS_BIGENDIAN DynFlags
dflags then [a] -> [a]
forall a. a -> a
id else [a] -> [a]
forall a. [a] -> [a]
reverse
str :: String
str = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
fixEndian ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
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 :: Float -> SDoc
ppFloat :: Float -> SDoc
ppFloat = Double -> SDoc
ppDouble (Double -> SDoc) -> (Float -> Double) -> Float -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
widenFp
ppCommaJoin :: (Outputable a) => [a] -> SDoc
ppCommaJoin :: [a] -> SDoc
ppCommaJoin [a]
strs = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
strs)
ppSpaceJoin :: (Outputable a) => [a] -> SDoc
ppSpaceJoin :: [a] -> SDoc
ppSpaceJoin [a]
strs = [SDoc] -> SDoc
hsep ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
strs)