module Llvm.Types where
#include "HsVersions.h"
-#include "ghcconfig.h"
import Data.Char
import Numeric
--
-- | A global mutable variable. Maybe defined or external
-type LMGlobal = (LlvmVar, Maybe LlvmStatic)
+type LMGlobal = (LlvmVar, Maybe LlvmStatic)
-- | A String in LLVM
-type LMString = FastString
+type LMString = FastString
+-- | A type alias
+type LlvmAlias = (LMString, LlvmType)
--- | Llvm Types.
+-- | Llvm Types
data LlvmType
- = LMInt Int -- ^ An integer with a given width in bits.
- | LMFloat -- ^ 32 bit floating point
- | LMDouble -- ^ 64 bit floating point
- | LMFloat80 -- ^ 80 bit (x86 only) floating point
- | LMFloat128 -- ^ 128 bit floating point
- | LMPointer LlvmType -- ^ A pointer to a 'LlvmType'
- | LMArray Int LlvmType -- ^ An array of 'LlvmType'
- | LMLabel -- ^ A 'LlvmVar' can represent a label (address)
- | LMVoid -- ^ Void type
- | LMStruct [LlvmType] -- ^ Structure type
- | LMAlias LMString LlvmType -- ^ A type alias
+ = LMInt Int -- ^ An integer with a given width in bits.
+ | LMFloat -- ^ 32 bit floating point
+ | LMDouble -- ^ 64 bit floating point
+ | LMFloat80 -- ^ 80 bit (x86 only) floating point
+ | LMFloat128 -- ^ 128 bit floating point
+ | LMPointer LlvmType -- ^ A pointer to a 'LlvmType'
+ | LMArray Int LlvmType -- ^ An array of 'LlvmType'
+ | LMLabel -- ^ A 'LlvmVar' can represent a label (address)
+ | LMVoid -- ^ Void type
+ | LMStruct [LlvmType] -- ^ Structure type
+ | LMAlias LlvmAlias -- ^ A type alias
-- | Function type, used to create pointers to functions
| LMFunction LlvmFunctionDecl
show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
show (LMLabel ) = "label"
show (LMVoid ) = "void"
- show (LMStruct tys ) = "{" ++ (commaCat tys) ++ "}"
+ show (LMStruct tys ) = "<{" ++ (commaCat tys) ++ "}>"
- show (LMFunction (LlvmFunctionDecl _ _ _ r VarArgs p _))
- = show r ++ " (" ++ (either commaCat commaCat p) ++ ", ...)"
- show (LMFunction (LlvmFunctionDecl _ _ _ r FixedArgs p _))
- = show r ++ " (" ++ (either commaCat commaCat p) ++ ")"
+ show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
+ = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists
+ map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p
+ varg' = case varg of
+ VarArgs | not (null args) -> ", ..."
+ | otherwise -> "..."
+ _otherwise -> ""
+ in show r ++ " (" ++ args ++ varg' ++ ")"
- show (LMAlias s _ ) = "%" ++ unpackFS s
+ show (LMAlias (s,_)) = "%" ++ unpackFS s
--- | An LLVM section defenition. If Nothing then let LLVM decide the section
+-- | An LLVM section definition. If Nothing then let LLVM decide the section
type LMSection = Maybe LMString
type LMAlign = Maybe Int
type LMConst = Bool -- ^ is a variable constant or not
= LMIntLit Integer LlvmType
-- | Floating point literal
| LMFloatLit Double LlvmType
+ -- | Literal NULL, only applicable to pointer types
+ | LMNullLit LlvmType
+ -- | Undefined value, random bit pattern. Useful for optimisations.
+ | LMUndefLit LlvmType
deriving (Eq)
instance Show LlvmLit where
show (LMStaticStruc d t)
= let struc = case d of
- [] -> "{}"
- ts -> "{" ++ show (head ts) ++
- concat (map (\x -> "," ++ show x) (tail ts)) ++ "}"
+ [] -> "<{}>"
+ ts -> "<{" ++ show (head ts) ++
+ concat (map (\x -> "," ++ show x) (tail ts)) ++ "}>"
in show t ++ " " ++ struc
show (LMStaticPointer v) = show v
show (LMAdd s1 s2)
= let ty1 = getStatType s1
+ op = if isFloat ty1 then " fadd (" else " add ("
in if ty1 == getStatType s2
- then show ty1 ++ " add (" ++ show s1 ++ "," ++ show s2 ++ ")"
+ then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
else error $ "LMAdd with different types! s1: "
++ show s1 ++ ", s2: " ++ show s2
show (LMSub s1 s2)
= let ty1 = getStatType s1
+ op = if isFloat ty1 then " fsub (" else " sub ("
in if ty1 == getStatType s2
- then show ty1 ++ " sub (" ++ show s1 ++ "," ++ show s2 ++ ")"
+ then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
else error $ "LMSub with different types! s1: "
++ show s1 ++ ", s2: " ++ show s2
commaCat [] = ""
commaCat x = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x))
+-- | Concatenate an array together, separated by commas
+spaceCat :: Show a => [a] -> String
+spaceCat [] = ""
+spaceCat x = show (head x) ++ (concat $ map (\y -> " " ++ show y) (tail x))
+
-- -----------------------------------------------------------------------------
-- ** Operations on LLVM Basic Types and Variables
--
-- in a plain textual representation (e.g. @x@, @y@ or @42@).
getPlainName :: LlvmVar -> String
getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x
-getPlainName (LMLocalVar x _ ) = show x
+getPlainName (LMLocalVar x LMLabel ) = show x
+getPlainName (LMLocalVar x _ ) = "l" ++ show x
getPlainName (LMNLocalVar x _ ) = unpackFS x
getPlainName (LMLitVar x ) = getLit x
getLit (LMFloatLit r LMFloat ) = fToStr $ realToFrac r
getLit (LMFloatLit r LMDouble) = dToStr r
getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f
+getLit (LMNullLit _) = "null"
+getLit (LMUndefLit _) = "undef"
-- | Return the 'LlvmType' of the 'LlvmVar'
getVarType :: LlvmVar -> LlvmType
getLitType :: LlvmLit -> LlvmType
getLitType (LMIntLit _ t) = t
getLitType (LMFloatLit _ t) = t
+getLitType (LMNullLit t) = t
+getLitType (LMUndefLit t) = t
-- | Return the 'LlvmType' of the 'LlvmStatic'
getStatType :: LlvmStatic -> LlvmType
llvmWidthInBits LMVoid = 0
llvmWidthInBits (LMStruct tys) = sum $ map llvmWidthInBits tys
llvmWidthInBits (LMFunction _) = 0
-llvmWidthInBits (LMAlias _ t) = llvmWidthInBits t
+llvmWidthInBits (LMAlias (_,t)) = llvmWidthInBits t
-- -----------------------------------------------------------------------------
-- | An LLVM Function
data LlvmFunctionDecl = LlvmFunctionDecl {
- -- | Unique identifier of the function.
+ -- | Unique identifier of the function
decName :: LMString,
- -- | LinkageType of the function.
+ -- | LinkageType of the function
funcLinkage :: LlvmLinkageType,
- -- | The calling convention of the function.
+ -- | The calling convention of the function
funcCc :: LlvmCallConvention,
-- | Type of the returned value
decReturnType :: LlvmType,
-- | Indicates if this function uses varargs
decVarargs :: LlvmParameterListType,
- -- | Signature of the parameters, can be just types or full vars
- -- if parameter names are required.
- decParams :: Either [LlvmType] [LlvmVar],
+ -- | Parameter types and attributes
+ decParams :: [LlvmParameter],
-- | Function align value, must be power of 2
funcAlign :: LMAlign
}
instance Show LlvmFunctionDecl where
show (LlvmFunctionDecl n l c r varg p a)
- = let varg' = if varg == VarArgs then ", ..." else ""
+ = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists
+ map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p
+ varg' = case varg of
+ VarArgs | not (null args) -> ", ..."
+ | otherwise -> "..."
+ _otherwise -> ""
align = case a of
Just a' -> " align " ++ show a'
Nothing -> ""
- in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
- "(" ++ (either commaCat commaCat p) ++ varg' ++ ")" ++ align
+ in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
+ "(" ++ args ++ varg' ++ ")" ++ align
type LlvmFunctionDecls = [LlvmFunctionDecl]
+type LlvmParameter = (LlvmType, [LlvmParamAttr])
+
+-- | LLVM Parameter Attributes.
+--
+-- Parameter attributes are used to communicate additional information about
+-- the result or parameters of a function
+data LlvmParamAttr
+ -- | This indicates to the code generator that the parameter or return value
+ -- should be zero-extended to a 32-bit value by the caller (for a parameter)
+ -- or the callee (for a return value).
+ = ZeroExt
+ -- | This indicates to the code generator that the parameter or return value
+ -- should be sign-extended to a 32-bit value by the caller (for a parameter)
+ -- or the callee (for a return value).
+ | SignExt
+ -- | This indicates that this parameter or return value should be treated in
+ -- a special target-dependent fashion during while emitting code for a
+ -- function call or return (usually, by putting it in a register as opposed
+ -- to memory).
+ | InReg
+ -- | This indicates that the pointer parameter should really be passed by
+ -- value to the function.
+ | ByVal
+ -- | This indicates that the pointer parameter specifies the address of a
+ -- structure that is the return value of the function in the source program.
+ | SRet
+ -- | This indicates that the pointer does not alias any global or any other
+ -- parameter.
+ | NoAlias
+ -- | This indicates that the callee does not make any copies of the pointer
+ -- that outlive the callee itself
+ | NoCapture
+ -- | This indicates that the pointer parameter can be excised using the
+ -- trampoline intrinsics.
+ | Nest
+ deriving (Eq)
+
+instance Show LlvmParamAttr where
+ show ZeroExt = "zeroext"
+ show SignExt = "signext"
+ show InReg = "inreg"
+ show ByVal = "byval"
+ show SRet = "sret"
+ show NoAlias = "noalias"
+ show NoCapture = "nocapture"
+ show Nest = "nest"
-- | Llvm Function Attributes.
--
| LM_MO_Mul -- ^ multiply ..
| LM_MO_UDiv -- ^ unsigned integer or vector division.
| LM_MO_SDiv -- ^ signed integer ..
- | LM_MO_FDiv -- ^ floating point ..
| LM_MO_URem -- ^ unsigned integer or vector remainder (mod)
| LM_MO_SRem -- ^ signed ...
- | LM_MO_FRem -- ^ floating point ...
+
+ | LM_MO_FAdd -- ^ add two floating point or vector values.
+ | LM_MO_FSub -- ^ subtract two ...
+ | LM_MO_FMul -- ^ multiply ...
+ | LM_MO_FDiv -- ^ divide ...
+ | LM_MO_FRem -- ^ remainder ...
-- | Left shift
| LM_MO_Shl
show LM_MO_Mul = "mul"
show LM_MO_UDiv = "udiv"
show LM_MO_SDiv = "sdiv"
- show LM_MO_FDiv = "fdiv"
show LM_MO_URem = "urem"
show LM_MO_SRem = "srem"
+ show LM_MO_FAdd = "fadd"
+ show LM_MO_FSub = "fsub"
+ show LM_MO_FMul = "fmul"
+ show LM_MO_FDiv = "fdiv"
show LM_MO_FRem = "frem"
show LM_MO_Shl = "shl"
show LM_MO_LShr = "lshr"