{-# LANGUAGE LambdaCase #-}
module GHC.Llvm.Types where
import GHC.Prelude
import Data.Char
import Numeric
import GHC.Platform
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
(LlvmType -> LlvmType -> Bool)
-> (LlvmType -> LlvmType -> Bool) -> Eq LlvmType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LlvmType -> LlvmType -> Bool
== :: LlvmType -> LlvmType -> Bool
$c/= :: LlvmType -> LlvmType -> Bool
/= :: 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
<> Int -> 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    -> LlvmType -> SDoc
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
<> 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
']'
  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
'>'
  LlvmType
LMLabel        -> String -> SDoc
text String
"label"
  LlvmType
LMVoid         -> String -> SDoc
text String
"void"
  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
"}>"
  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
"}"
  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
_)
    -> 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
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
ppParams LlvmParameterListType
varg [LlvmParameter]
p
  = let varg' :: SDoc
varg' = case LlvmParameterListType
varg of
          LlvmParameterListType
VarArgs | [LlvmType] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LlvmType]
args -> String -> SDoc
text String
"..."
                  | Bool
otherwise -> String -> SDoc
text String
", ..."
          LlvmParameterListType
_otherwise          -> String -> SDoc
text 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
<> SDoc
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
$c== :: LMConst -> LMConst -> Bool
== :: LMConst -> LMConst -> Bool
$c/= :: LMConst -> LMConst -> Bool
/= :: 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
$c== :: LlvmVar -> LlvmVar -> Bool
== :: LlvmVar -> LlvmVar -> Bool
$c/= :: LlvmVar -> LlvmVar -> Bool
/= :: LlvmVar -> LlvmVar -> Bool
Eq)
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
$c== :: LlvmLit -> LlvmLit -> Bool
== :: LlvmLit -> LlvmLit -> Bool
$c/= :: LlvmLit -> LlvmLit -> Bool
/= :: LlvmLit -> LlvmLit -> Bool
Eq)
data LlvmStatic
  =  LMString                  
  | LMStaticLit LlvmLit                 
  | LMUninitType LlvmType               
  | LMStaticStr LMString LlvmType       
  | LMStaticArray [LlvmStatic] LlvmType 
  | LMStaticStruc [LlvmStatic] LlvmType 
  | LMStaticStrucU [LlvmStatic] LlvmType 
  | LMStaticPointer LlvmVar             
  
  
  | LMTrunc LlvmStatic LlvmType        
  | LMBitc LlvmStatic LlvmType         
  | LMPtoI LlvmStatic LlvmType         
  | LMAdd LlvmStatic LlvmStatic        
  | LMSub LlvmStatic LlvmStatic        
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 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 [])  = String -> LlvmType
forall a. String -> a
panic String
"getLitType"
getLitType (LMVectorLit [LlvmLit]
ls)  = Int -> LlvmType -> LlvmType
LMVector ([LlvmLit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LlvmLit]
ls) (LlvmLit -> LlvmType
getLitType ([LlvmLit] -> LlvmLit
forall a. HasCallStack => [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 (LMStaticStrucU [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
_) = String -> LlvmType
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    = 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 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
_          ) = 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 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
_          ) = 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 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform LlvmType
t
   (LMVector Int
n LlvmType
ty) -> Int
n Int -> Int -> Int
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)  -> [Int] -> Int
forall a. Num a => [a] -> a
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 (Platform -> LlvmType -> Int
llvmWidthInBits Platform
platform) [LlvmType]
tys
   (LMStructU [LlvmType]
_)   ->
    
    
    
    
    
    
    
    
    String -> Int
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      -> 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 :: Platform -> LlvmType
llvmWord :: Platform -> LlvmType
llvmWord    Platform
platform = Int -> LlvmType
LMInt (Platform -> Int
platformWordSizeInBytes Platform
platform Int -> Int -> Int
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
(LlvmFunctionDecl -> LlvmFunctionDecl -> Bool)
-> (LlvmFunctionDecl -> LlvmFunctionDecl -> Bool)
-> Eq LlvmFunctionDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
== :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
$c/= :: LlvmFunctionDecl -> LlvmFunctionDecl -> Bool
/= :: 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
<> 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
<> 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
(LlvmParamAttr -> LlvmParamAttr -> Bool)
-> (LlvmParamAttr -> LlvmParamAttr -> Bool) -> Eq LlvmParamAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LlvmParamAttr -> LlvmParamAttr -> Bool
== :: LlvmParamAttr -> LlvmParamAttr -> Bool
$c/= :: LlvmParamAttr -> LlvmParamAttr -> Bool
/= :: 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
$c== :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
== :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
$c/= :: LlvmFuncAttr -> LlvmFuncAttr -> Bool
/= :: 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
(LlvmCallType -> LlvmCallType -> Bool)
-> (LlvmCallType -> LlvmCallType -> Bool) -> Eq LlvmCallType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LlvmCallType -> LlvmCallType -> Bool
== :: LlvmCallType -> LlvmCallType -> Bool
$c/= :: LlvmCallType -> LlvmCallType -> Bool
/= :: LlvmCallType -> LlvmCallType -> Bool
Eq,Int -> LlvmCallType -> ShowS
[LlvmCallType] -> ShowS
LlvmCallType -> String
(Int -> LlvmCallType -> ShowS)
-> (LlvmCallType -> String)
-> ([LlvmCallType] -> ShowS)
-> Show LlvmCallType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LlvmCallType -> ShowS
showsPrec :: Int -> LlvmCallType -> ShowS
$cshow :: LlvmCallType -> String
show :: LlvmCallType -> String
$cshowList :: [LlvmCallType] -> ShowS
showList :: [LlvmCallType] -> ShowS
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
$c== :: LlvmCallConvention -> LlvmCallConvention -> Bool
== :: LlvmCallConvention -> LlvmCallConvention -> Bool
$c/= :: LlvmCallConvention -> LlvmCallConvention -> Bool
/= :: 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
$c== :: LlvmParameterListType -> LlvmParameterListType -> Bool
== :: LlvmParameterListType -> LlvmParameterListType -> Bool
$c/= :: LlvmParameterListType -> LlvmParameterListType -> Bool
/= :: LlvmParameterListType -> LlvmParameterListType -> Bool
Eq,Int -> LlvmParameterListType -> ShowS
[LlvmParameterListType] -> ShowS
LlvmParameterListType -> String
(Int -> LlvmParameterListType -> ShowS)
-> (LlvmParameterListType -> String)
-> ([LlvmParameterListType] -> ShowS)
-> Show LlvmParameterListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LlvmParameterListType -> ShowS
showsPrec :: Int -> LlvmParameterListType -> ShowS
$cshow :: LlvmParameterListType -> String
show :: LlvmParameterListType -> String
$cshowList :: [LlvmParameterListType] -> ShowS
showList :: [LlvmParameterListType] -> ShowS
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
$c== :: LlvmLinkageType -> LlvmLinkageType -> Bool
== :: LlvmLinkageType -> LlvmLinkageType -> Bool
$c/= :: LlvmLinkageType -> LlvmLinkageType -> Bool
/= :: 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
$c== :: LlvmMachOp -> LlvmMachOp -> Bool
== :: LlvmMachOp -> LlvmMachOp -> Bool
$c/= :: LlvmMachOp -> LlvmMachOp -> Bool
/= :: 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
$c== :: LlvmCmpOp -> LlvmCmpOp -> Bool
== :: LlvmCmpOp -> LlvmCmpOp -> Bool
$c/= :: LlvmCmpOp -> LlvmCmpOp -> Bool
/= :: 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
$c== :: LlvmCastOp -> LlvmCastOp -> Bool
== :: LlvmCastOp -> LlvmCastOp -> Bool
$c/= :: LlvmCastOp -> LlvmCastOp -> Bool
/= :: 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 :: [Word8]
bs     = Double -> [Word8]
doubleToBytes Double
d
        hex :: a -> String
hex a
d' = case a -> ShowS
forall a. Integral a => a -> ShowS
showHex a
d' String
"" of
            []    -> ShowS
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
_     -> ShowS
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    -> [String] -> [String]
forall a. a -> a
id
            ByteOrder
LittleEndian -> [String] -> [String]
forall a. [a] -> [a]
reverse
        str :: String
str       = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS
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]
fixEndian ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
forall {a}. Integral a => a -> String
hex [Word8]
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 (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 :: forall a. Outputable a => [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 :: forall a. Outputable a => [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)