--- /dev/null
+--------------------------------------------------------------------------------
+-- | The LLVM Type System.
+--
+
+module Llvm.Types where
+
+#include "HsVersions.h"
+#include "ghcconfig.h"
+
+import Data.Char
+import Numeric
+
+import Constants
+import FastString
+import Unique
+
+-- from NCG
+import PprBase
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Basic Types and Variables
+--
+
+-- | A global mutable variable. Maybe defined or external
+type LMGlobal = (LlvmVar, Maybe LlvmStatic)
+-- | A global constant variable
+type LMConstant = (LlvmVar, LlvmStatic)
+-- | A String in LLVM
+type LMString = FastString
+
+
+-- | 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
+
+ -- | Function type, used to create pointers to functions
+ | LMFunction LlvmFunctionDecl
+ deriving (Eq)
+
+instance Show LlvmType where
+ show (LMInt size ) = "i" ++ show size
+ show (LMFloat ) = "float"
+ show (LMDouble ) = "double"
+ show (LMFloat80 ) = "x86_fp80"
+ show (LMFloat128 ) = "fp128"
+ show (LMPointer x ) = show x ++ "*"
+ show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
+ show (LMLabel ) = "label"
+ show (LMVoid ) = "void"
+ 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 (LMAlias s _ ) = "%" ++ unpackFS s
+
+
+-- | Llvm Variables
+data LlvmVar
+ -- | Variables with a global scope.
+ = LMGlobalVar LMString LlvmType LlvmLinkageType
+ -- | Variables local to a function or parameters.
+ | LMLocalVar Unique LlvmType
+ -- | Named local variables. Sometimes we need to be able to explicitly name
+ -- variables (e.g for function arguments).
+ | LMNLocalVar LMString LlvmType
+ -- | A constant variable
+ | LMLitVar LlvmLit
+ deriving (Eq)
+
+instance Show LlvmVar where
+ show (LMLitVar x) = show x
+ show (x ) = show (getVarType x) ++ " " ++ getName x
+
+
+-- | Llvm Literal Data.
+--
+-- These can be used inline in expressions.
+data LlvmLit
+ -- | Refers to an integer constant (i64 42).
+ = LMIntLit Integer LlvmType
+ -- | Floating point literal
+ | LMFloatLit Rational LlvmType
+ deriving (Eq)
+
+instance Show LlvmLit where
+ show l = show (getLitType l) ++ " " ++ getLit l
+
+
+-- | Llvm Static Data.
+--
+-- These represent the possible global level variables and constants.
+data LlvmStatic
+ = LMComment LMString -- ^ A comment in a static section
+ | LMStaticLit LlvmLit -- ^ A static variant of a literal value
+ | LMUninitType LlvmType -- ^ For uninitialised data
+ | LMStaticStr LMString LlvmType -- ^ Defines a static 'LMString'
+ | LMStaticArray [LlvmStatic] LlvmType -- ^ A static array
+ | LMStaticStruc [LlvmStatic] LlvmType -- ^ A static structure type
+ | LMStaticPointer LlvmVar -- ^ A pointer to other data
+
+ -- static expressions, could split out but leave
+ -- for moment for ease of use. Not many of them.
+
+ | LMPtoI LlvmStatic LlvmType -- ^ Pointer to Integer conversion
+ | LMAdd LlvmStatic LlvmStatic -- ^ Constant addition operation
+ | LMSub LlvmStatic LlvmStatic -- ^ Constant subtraction operation
+ deriving (Eq)
+
+instance Show LlvmStatic where
+ show (LMComment s) = "; " ++ unpackFS s
+ show (LMStaticLit l ) = show l
+ show (LMUninitType t) = show t ++ " undef"
+ show (LMStaticStr s t) = show t ++ " c\"" ++ unpackFS s ++ "\\00\""
+
+ show (LMStaticArray d t)
+ = let struc = case d of
+ [] -> "[]"
+ ts -> "[" ++
+ (show (head ts) ++ concat (map (\x -> "," ++ show x)
+ (tail ts)))
+ ++ "]"
+ in show t ++ " " ++ struc
+
+ show (LMStaticStruc d t)
+ = let struc = case d of
+ [] -> "{}"
+ ts -> "{" ++
+ (show (head ts) ++ concat (map (\x -> "," ++ show x)
+ (tail ts)))
+ ++ "}"
+ in show t ++ " " ++ struc
+
+ show (LMStaticPointer v) = show v
+
+ show (LMPtoI v t)
+ = show t ++ " ptrtoint (" ++ show v ++ " to " ++ show t ++ ")"
+
+ show (LMAdd s1 s2)
+ = let ty1 = getStatType s1
+ in if ty1 == getStatType s2
+ then show ty1 ++ " add (" ++ show s1 ++ "," ++ show s2 ++ ")"
+ else error $ "LMAdd with different types! s1: "
+ ++ show s1 ++ ", s2: " ++ show s2
+ show (LMSub s1 s2)
+ = let ty1 = getStatType s1
+ in if ty1 == getStatType s2
+ then show ty1 ++ " sub (" ++ show s1 ++ "," ++ show s2 ++ ")"
+ else error $ "LMSub with different types! s1: "
+ ++ show s1 ++ ", s2: " ++ show s2
+
+
+-- | Concatenate an array together, separated by commas
+commaCat :: Show a => [a] -> String
+commaCat [] = ""
+commaCat x = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x))
+
+-- -----------------------------------------------------------------------------
+-- ** Operations on LLVM Basic Types and Variables
+--
+
+-- | Return the variable name or value of the 'LlvmVar'
+-- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
+getName :: LlvmVar -> String
+getName v@(LMGlobalVar _ _ _ ) = "@" ++ getPlainName v
+getName v@(LMLocalVar _ _ ) = "%" ++ getPlainName v
+getName v@(LMNLocalVar _ _ ) = "%" ++ getPlainName v
+getName v@(LMLitVar _ ) = getPlainName v
+
+-- | Return the variable name or value of the 'LlvmVar'
+-- 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 (LMNLocalVar x _ ) = unpackFS x
+getPlainName (LMLitVar x ) = getLit x
+
+-- | Print a literal value. No type.
+getLit :: LlvmLit -> String
+getLit (LMIntLit i _) = show ((fromInteger i)::Int)
+-- In Llvm float literals can be printed in a big-endian hexadecimal format,
+-- regardless of underlying architecture.
+getLit (LMFloatLit r LMFloat) = fToStr $ fromRational r
+getLit (LMFloatLit r LMDouble) = dToStr $ fromRational r
+getLit l = error $ "getLit: Usupported LlvmLit type! " ++ show (getLitType l)
+
+-- | Return the 'LlvmType' of the 'LlvmVar'
+getVarType :: LlvmVar -> LlvmType
+getVarType (LMGlobalVar _ y _) = y
+getVarType (LMLocalVar _ y ) = y
+getVarType (LMNLocalVar _ y ) = y
+getVarType (LMLitVar l ) = getLitType l
+
+-- | Return the 'LlvmType' of a 'LlvmLit'
+getLitType :: LlvmLit -> LlvmType
+getLitType (LMIntLit _ t) = t
+getLitType (LMFloatLit _ t) = t
+
+-- | Return the 'LlvmType' of the 'LlvmStatic'
+getStatType :: LlvmStatic -> LlvmType
+getStatType (LMStaticLit l ) = getLitType l
+getStatType (LMUninitType t) = t
+getStatType (LMStaticStr _ t) = t
+getStatType (LMStaticArray _ t) = t
+getStatType (LMStaticStruc _ t) = t
+getStatType (LMStaticPointer v) = getVarType v
+getStatType (LMPtoI _ t) = t
+getStatType (LMAdd t _) = getStatType t
+getStatType (LMSub t _) = getStatType t
+getStatType (LMComment _) = error "Can't call getStatType on LMComment!"
+
+-- | Return the 'LlvmType' of the 'LMGlobal'
+getGlobalType :: LMGlobal -> LlvmType
+getGlobalType (v, _) = getVarType v
+
+-- | Return the 'LlvmVar' part of a 'LMGlobal'
+getGlobalVar :: LMGlobal -> LlvmVar
+getGlobalVar (v, _) = v
+
+-- | Return the 'LlvmLinkageType' for a 'LlvmVar'
+getLink :: LlvmVar -> LlvmLinkageType
+getLink (LMGlobalVar _ _ l) = l
+getLink _ = ExternallyVisible
+
+-- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
+-- cannot be lifted.
+pLift :: LlvmType -> LlvmType
+pLift (LMLabel) = error "Labels are unliftable"
+pLift (LMVoid) = error "Voids are unliftable"
+pLift x = LMPointer x
+
+-- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
+-- constructors can be lowered.
+pLower :: LlvmType -> LlvmType
+pLower (LMPointer x) = x
+pLower x = error $ show x ++ " is a unlowerable type, need a pointer"
+
+-- | Lower a variable of 'LMPointer' type.
+pVarLower :: LlvmVar -> LlvmVar
+pVarLower (LMGlobalVar s t l) = LMGlobalVar s (pLower t) l
+pVarLower (LMLocalVar s t ) = LMLocalVar s (pLower t)
+pVarLower (LMNLocalVar s t ) = LMNLocalVar s (pLower t)
+pVarLower (LMLitVar _ ) = error $ "Can't lower a literal type!"
+
+-- | Test if the given 'LlvmType' is an integer
+isInt :: LlvmType -> Bool
+isInt (LMInt _) = True
+isInt _ = False
+
+-- | Test if the given 'LlvmType' is a floating point type
+isFloat :: LlvmType -> Bool
+isFloat LMFloat = True
+isFloat LMDouble = True
+isFloat LMFloat80 = True
+isFloat LMFloat128 = True
+isFloat _ = False
+
+-- | Test if the given 'LlvmType' is an 'LMPointer' construct
+isPointer :: LlvmType -> Bool
+isPointer (LMPointer _) = True
+isPointer _ = False
+
+-- | Test if a 'LlvmVar' is global.
+isGlobal :: LlvmVar -> Bool
+isGlobal (LMGlobalVar _ _ _) = True
+isGlobal _ = False
+
+-- | Width in bits of an 'LlvmType', returns 0 if not applicable
+llvmWidthInBits :: LlvmType -> Int
+llvmWidthInBits (LMInt n) = n
+llvmWidthInBits (LMFloat) = 32
+llvmWidthInBits (LMDouble) = 64
+llvmWidthInBits (LMFloat80) = 80
+llvmWidthInBits (LMFloat128) = 128
+-- Could return either a pointer width here or the width of what
+-- it points to. We will go with the former for now.
+llvmWidthInBits (LMPointer _) = llvmWidthInBits llvmWord
+llvmWidthInBits (LMArray _ _) = llvmWidthInBits llvmWord
+llvmWidthInBits LMLabel = 0
+llvmWidthInBits LMVoid = 0
+llvmWidthInBits (LMStruct tys) = sum $ map llvmWidthInBits tys
+llvmWidthInBits (LMFunction _) = 0
+llvmWidthInBits (LMAlias _ t) = llvmWidthInBits t
+
+
+-- -----------------------------------------------------------------------------
+-- ** Shortcut for Common Types
+--
+
+i128, i64, i32, i16, i8, i1 :: LlvmType
+i128 = LMInt 128
+i64 = LMInt 64
+i32 = LMInt 32
+i16 = LMInt 16
+i8 = LMInt 8
+i1 = LMInt 1
+
+-- | The target architectures word size
+llvmWord :: LlvmType
+llvmWord = LMInt (wORD_SIZE * 8)
+
+-- | The target architectures pointer size
+llvmWordPtr :: LlvmType
+llvmWordPtr = pLift llvmWord
+
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Function Types
+--
+
+-- | An LLVM Function
+data LlvmFunctionDecl = LlvmFunctionDecl {
+ -- | Unique identifier of the function.
+ decName :: LMString,
+ -- | LinkageType of the function.
+ funcLinkage :: LlvmLinkageType,
+ -- | 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]
+ }
+
+instance Show LlvmFunctionDecl where
+ show (LlvmFunctionDecl n l c r VarArgs p)
+ = (show l) ++ " " ++ (show c) ++ " " ++ (show r)
+ ++ " @" ++ unpackFS n ++ "(" ++ (either commaCat commaCat p) ++ ", ...)"
+ show (LlvmFunctionDecl n l c r FixedArgs p)
+ = (show l) ++ " " ++ (show c) ++ " " ++ (show r)
+ ++ " @" ++ unpackFS n ++ "(" ++ (either commaCat commaCat p) ++ ")"
+
+instance Eq LlvmFunctionDecl where
+ (LlvmFunctionDecl n1 l1 c1 r1 v1 p1) == (LlvmFunctionDecl n2 l2 c2 r2 v2 p2)
+ = (n1 == n2) && (l1 == l2) && (c1 == c2) && (r1 == r2)
+ && (v1 == v2) && (p1 == p2)
+
+type LlvmFunctionDecls = [LlvmFunctionDecl]
+
+
+-- | Llvm Function Attributes.
+--
+-- Function attributes are set to communicate additional information about a
+-- function. Function attributes are considered to be part of the function,
+-- not of the function type, so functions with different parameter attributes
+-- can have the same function type. Functions can have multiple attributes.
+--
+-- Descriptions taken from <http://llvm.org/docs/LangRef.html#fnattrs>
+data LlvmFuncAttr
+ -- | This attribute indicates that the inliner should attempt to inline this
+ -- function into callers whenever possible, ignoring any active inlining
+ -- size threshold for this caller.
+ = AlwaysInline
+ -- | This attribute indicates that the source code contained a hint that
+ -- inlining this function is desirable (such as the \"inline\" keyword in
+ -- C/C++). It is just a hint; it imposes no requirements on the inliner.
+ | InlineHint
+ -- | This attribute indicates that the inliner should never inline this
+ -- function in any situation. This attribute may not be used together
+ -- with the alwaysinline attribute.
+ | NoInline
+ -- | This attribute suggests that optimization passes and code generator
+ -- passes make choices that keep the code size of this function low, and
+ -- otherwise do optimizations specifically to reduce code size.
+ | OptSize
+ -- | This function attribute indicates that the function never returns
+ -- normally. This produces undefined behavior at runtime if the function
+ -- ever does dynamically return.
+ | NoReturn
+ -- | This function attribute indicates that the function never returns with
+ -- an unwind or exceptional control flow. If the function does unwind, its
+ -- runtime behavior is undefined.
+ | NoUnwind
+ -- | This attribute indicates that the function computes its result (or
+ -- decides to unwind an exception) based strictly on its arguments, without
+ -- dereferencing any pointer arguments or otherwise accessing any mutable
+ -- state (e.g. memory, control registers, etc) visible to caller functions.
+ -- It does not write through any pointer arguments (including byval
+ -- arguments) and never changes any state visible to callers. This means
+ -- that it cannot unwind exceptions by calling the C++ exception throwing
+ -- methods, but could use the unwind instruction.
+ | ReadNone
+ -- | This attribute indicates that the function does not write through any
+ -- pointer arguments (including byval arguments) or otherwise modify any
+ -- state (e.g. memory, control registers, etc) visible to caller functions.
+ -- It may dereference pointer arguments and read state that may be set in
+ -- the caller. A readonly function always returns the same value (or unwinds
+ -- an exception identically) when called with the same set of arguments and
+ -- global state. It cannot unwind an exception by calling the C++ exception
+ -- throwing methods, but may use the unwind instruction.
+ | ReadOnly
+ -- | This attribute indicates that the function should emit a stack smashing
+ -- protector. It is in the form of a \"canary\"—a random value placed on the
+ -- stack before the local variables that's checked upon return from the
+ -- function to see if it has been overwritten. A heuristic is used to
+ -- determine if a function needs stack protectors or not.
+ --
+ -- If a function that has an ssp attribute is inlined into a function that
+ -- doesn't have an ssp attribute, then the resulting function will have an
+ -- ssp attribute.
+ | Ssp
+ -- | This attribute indicates that the function should always emit a stack
+ -- smashing protector. This overrides the ssp function attribute.
+ --
+ -- If a function that has an sspreq attribute is inlined into a function
+ -- that doesn't have an sspreq attribute or which has an ssp attribute,
+ -- then the resulting function will have an sspreq attribute.
+ | SspReq
+ -- | This attribute indicates that the code generator should not use a red
+ -- zone, even if the target-specific ABI normally permits it.
+ | NoRedZone
+ -- | This attributes disables implicit floating point instructions.
+ | NoImplicitFloat
+ -- | This attribute disables prologue / epilogue emission for the function.
+ -- This can have very system-specific consequences.
+ | Naked
+ deriving (Eq)
+
+instance Show LlvmFuncAttr where
+ show AlwaysInline = "alwaysinline"
+ show InlineHint = "inlinehint"
+ show NoInline = "noinline"
+ show OptSize = "optsize"
+ show NoReturn = "noreturn"
+ show NoUnwind = "nounwind"
+ show ReadNone = "readnon"
+ show ReadOnly = "readonly"
+ show Ssp = "ssp"
+ show SspReq = "ssqreq"
+ show NoRedZone = "noredzone"
+ show NoImplicitFloat = "noimplicitfloat"
+ show Naked = "naked"
+
+
+-- | Different types to call a function.
+data LlvmCallType
+ -- | Normal call, allocate a new stack frame.
+ = StdCall
+ -- | Tail call, perform the call in the current stack frame.
+ | TailCall
+ deriving (Eq,Show)
+
+-- | Different calling conventions a function can use.
+data LlvmCallConvention
+ -- | The C calling convention.
+ -- This calling convention (the default if no other calling convention is
+ -- specified) matches the target C calling conventions. This calling
+ -- convention supports varargs function calls and tolerates some mismatch in
+ -- the declared prototype and implemented declaration of the function (as
+ -- does normal C).
+ = CC_Ccc
+ -- | This calling convention attempts to make calls as fast as possible
+ -- (e.g. by passing things in registers). This calling convention allows
+ -- the target to use whatever tricks it wants to produce fast code for the
+ -- target, without having to conform to an externally specified ABI
+ -- (Application Binary Interface). Implementations of this convention should
+ -- allow arbitrary tail call optimization to be supported. This calling
+ -- convention does not support varargs and requires the prototype of al
+ -- callees to exactly match the prototype of the function definition.
+ | CC_Fastcc
+ -- | This calling convention attempts to make code in the caller as efficient
+ -- as possible under the assumption that the call is not commonly executed.
+ -- As such, these calls often preserve all registers so that the call does
+ -- not break any live ranges in the caller side. This calling convention
+ -- does not support varargs and requires the prototype of all callees to
+ -- exactly match the prototype of the function definition.
+ | CC_Coldcc
+ -- | Any calling convention may be specified by number, allowing
+ -- target-specific calling conventions to be used. Target specific calling
+ -- conventions start at 64.
+ | CC_Ncc Int
+ -- | X86 Specific 'StdCall' convention. LLVM includes a specific alias for it
+ -- rather than just using CC_Ncc.
+ | CC_X86_Stdcc
+ deriving (Eq)
+
+instance Show LlvmCallConvention where
+ show CC_Ccc = "ccc"
+ show CC_Fastcc = "fastcc"
+ show CC_Coldcc = "coldcc"
+ show (CC_Ncc i) = "cc " ++ (show i)
+ show CC_X86_Stdcc = "x86_stdcallcc"
+
+
+-- | Functions can have a fixed amount of parameters, or a variable amount.
+data LlvmParameterListType
+ -- Fixed amount of arguments.
+ = FixedArgs
+ -- Variable amount of arguments.
+ | VarArgs
+ deriving (Eq,Show)
+
+
+-- | Linkage type of a symbol.
+--
+-- The description of the constructors is copied from the Llvm Assembly Language
+-- Reference Manual <http://www.llvm.org/docs/LangRef.html#linkage>, because
+-- they correspond to the Llvm linkage types.
+data LlvmLinkageType
+ -- | Global values with internal linkage are only directly accessible by
+ -- objects in the current module. In particular, linking code into a module
+ -- with an internal global value may cause the internal to be renamed as
+ -- necessary to avoid collisions. Because the symbol is internal to the
+ -- module, all references can be updated. This corresponds to the notion
+ -- of the @static@ keyword in C.
+ = Internal
+ -- | Globals with @linkonce@ linkage are merged with other globals of the
+ -- same name when linkage occurs. This is typically used to implement
+ -- inline functions, templates, or other code which must be generated
+ -- in each translation unit that uses it. Unreferenced linkonce globals are
+ -- allowed to be discarded.
+ | LinkOnce
+ -- | @weak@ linkage is exactly the same as linkonce linkage, except that
+ -- unreferenced weak globals may not be discarded. This is used for globals
+ -- that may be emitted in multiple translation units, but that are not
+ -- guaranteed to be emitted into every translation unit that uses them. One
+ -- example of this are common globals in C, such as @int X;@ at global
+ -- scope.
+ | Weak
+ -- | @appending@ linkage may only be applied to global variables of pointer
+ -- to array type. When two global variables with appending linkage are
+ -- linked together, the two global arrays are appended together. This is
+ -- the Llvm, typesafe, equivalent of having the system linker append
+ -- together @sections@ with identical names when .o files are linked.
+ | Appending
+ -- | The semantics of this linkage follow the ELF model: the symbol is weak
+ -- until linked, if not linked, the symbol becomes null instead of being an
+ -- undefined reference.
+ | ExternWeak
+ -- | The symbol participates in linkage and can be used to resolve external
+ -- symbol references.
+ | ExternallyVisible
+ -- | Alias for 'ExternallyVisible' but with explicit textual form in LLVM
+ -- assembly.
+ | External
+ deriving (Eq)
+
+instance Show LlvmLinkageType where
+ show Internal = "internal"
+ show LinkOnce = "linkonce"
+ show Weak = "weak"
+ show Appending = "appending"
+ show ExternWeak = "extern_weak"
+ -- ExternallyVisible does not have a textual representation, it is
+ -- the linkage type a function resolves to if no other is specified
+ -- in Llvm.
+ show ExternallyVisible = ""
+ show External = "external"
+
+
+-- -----------------------------------------------------------------------------
+-- * LLVM Operations
+--
+
+-- | Llvm binary operators machine operations.
+data LlvmMachOp
+ = LM_MO_Add -- ^ add two integer, floating point or vector values.
+ | LM_MO_Sub -- ^ subtract two ...
+ | 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 ...
+
+ -- | Left shift
+ | LM_MO_Shl
+ -- | Logical shift right
+ -- Shift right, filling with zero
+ | LM_MO_LShr
+ -- | Arithmetic shift right
+ -- The most significant bits of the result will be equal to the sign bit of
+ -- the left operand.
+ | LM_MO_AShr
+
+ | LM_MO_And -- ^ AND bitwise logical operation.
+ | LM_MO_Or -- ^ OR bitwise logical operation.
+ | LM_MO_Xor -- ^ XOR bitwise logical operation.
+ deriving (Eq)
+
+instance Show LlvmMachOp where
+ show LM_MO_Add = "add"
+ show LM_MO_Sub = "sub"
+ 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_FRem = "frem"
+ show LM_MO_Shl = "shl"
+ show LM_MO_LShr = "lshr"
+ show LM_MO_AShr = "ashr"
+ show LM_MO_And = "and"
+ show LM_MO_Or = "or"
+ show LM_MO_Xor = "xor"
+
+
+-- | Llvm compare operations.
+data LlvmCmpOp
+ = LM_CMP_Eq -- ^ Equal (Signed and Unsigned)
+ | LM_CMP_Ne -- ^ Not equal (Signed and Unsigned)
+ | LM_CMP_Ugt -- ^ Unsigned greater than
+ | LM_CMP_Uge -- ^ Unsigned greater than or equal
+ | LM_CMP_Ult -- ^ Unsigned less than
+ | LM_CMP_Ule -- ^ Unsigned less than or equal
+ | LM_CMP_Sgt -- ^ Signed greater than
+ | LM_CMP_Sge -- ^ Signed greater than or equal
+ | LM_CMP_Slt -- ^ Signed less than
+ | LM_CMP_Sle -- ^ Signed less than or equal
+
+ -- Float comparisons. GHC uses a mix of ordered and unordered float
+ -- comparisons.
+ | LM_CMP_Feq -- ^ Float equal
+ | LM_CMP_Fne -- ^ Float not equal
+ | LM_CMP_Fgt -- ^ Float greater than
+ | LM_CMP_Fge -- ^ Float greater than or equal
+ | LM_CMP_Flt -- ^ Float less than
+ | LM_CMP_Fle -- ^ Float less than or equal
+ deriving (Eq)
+
+instance Show LlvmCmpOp where
+ show LM_CMP_Eq = "eq"
+ show LM_CMP_Ne = "ne"
+ show LM_CMP_Ugt = "ugt"
+ show LM_CMP_Uge = "uge"
+ show LM_CMP_Ult = "ult"
+ show LM_CMP_Ule = "ule"
+ show LM_CMP_Sgt = "sgt"
+ show LM_CMP_Sge = "sge"
+ show LM_CMP_Slt = "slt"
+ show LM_CMP_Sle = "sle"
+ show LM_CMP_Feq = "oeq"
+ show LM_CMP_Fne = "une"
+ show LM_CMP_Fgt = "ogt"
+ show LM_CMP_Fge = "oge"
+ show LM_CMP_Flt = "olt"
+ show LM_CMP_Fle = "ole"
+
+
+-- | Llvm cast operations.
+data LlvmCastOp
+ = LM_Trunc -- ^ Integer truncate
+ | LM_Zext -- ^ Integer extend (zero fill)
+ | LM_Sext -- ^ Integer extend (sign fill)
+ | LM_Fptrunc -- ^ Float truncate
+ | LM_Fpext -- ^ Float extend
+ | LM_Fptoui -- ^ Float to unsigned Integer
+ | LM_Fptosi -- ^ Float to signed Integer
+ | LM_Uitofp -- ^ Unsigned Integer to Float
+ | LM_Sitofp -- ^ Signed Int to Float
+ | LM_Ptrtoint -- ^ Pointer to Integer
+ | LM_Inttoptr -- ^ Integer to Pointer
+ | LM_Bitcast -- ^ Cast between types where no bit manipulation is needed
+ deriving (Eq)
+
+instance Show LlvmCastOp where
+ show LM_Trunc = "trunc"
+ show LM_Zext = "zext"
+ show LM_Sext = "sext"
+ show LM_Fptrunc = "fptrunc"
+ show LM_Fpext = "fpext"
+ show LM_Fptoui = "fptoui"
+ show LM_Fptosi = "fptosi"
+ show LM_Uitofp = "uitofp"
+ show LM_Sitofp = "sitofp"
+ show LM_Ptrtoint = "ptrtoint"
+ show LM_Inttoptr = "inttoptr"
+ show LM_Bitcast = "bitcast"
+
+
+-- -----------------------------------------------------------------------------
+-- * Floating point conversion
+--
+
+-- | Convert a Haskell Float to an LLVM hex encoded floating point form
+fToStr :: Float -> String
+fToStr f = dToStr $ realToFrac f
+
+-- | Convert a Haskell Double to an LLVM hex encoded floating point form
+dToStr :: Double -> String
+dToStr d =
+ let bs = doubleToBytes d
+ hex d' = case showHex d' "" of
+ [] -> error "dToStr: too few hex digits for float"
+ [x] -> ['0',x]
+ [x,y] -> [x,y]
+ _ -> error "dToStr: too many hex digits for float"
+
+ str' = concat . fixEndian . (map hex) $ bs
+ str = map toUpper str'
+ in "0x" ++ str
+
+-- | Reverse or leave byte data alone to fix endianness on this
+-- target. LLVM generally wants things in Big-Endian form
+-- regardless of target architecture.
+fixEndian :: [a] -> [a]
+#ifdef WORDS_BIGENDIAN
+fixEndian = id
+#else
+fixEndian = reverse
+#endif
+
projects / ghc-hetmet.git / blobdiff