X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvm%2FTypes.hs;fp=compiler%2FllvmGen%2FLlvm%2FTypes.hs;h=a4080c4d5c9e8023bef9bbf5e35b5568a364e3c1;hb=49a8e5c021009430d373d6224b29004c7d18c408;hp=0000000000000000000000000000000000000000;hpb=0c41772cba7ec3f558cd2619716c7db771eae935;p=ghc-hetmet.git diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs new file mode 100644 index 0000000..a4080c4 --- /dev/null +++ b/compiler/llvmGen/Llvm/Types.hs @@ -0,0 +1,719 @@ +-------------------------------------------------------------------------------- +-- | 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 +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 , 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 +