Fix negate op not working for -0 in llvm backend
[ghc-hetmet.git] / compiler / llvmGen / Llvm / Types.hs
1 --------------------------------------------------------------------------------
2 -- | The LLVM Type System.
3 --
4
5 module Llvm.Types where
6
7 #include "HsVersions.h"
8 #include "ghcconfig.h"
9
10 import Data.Char
11 import Numeric
12
13 import Constants
14 import FastString
15 import Unique
16
17 -- from NCG
18 import PprBase
19
20 -- -----------------------------------------------------------------------------
21 -- * LLVM Basic Types and Variables
22 --
23
24 -- | A global mutable variable. Maybe defined or external
25 type LMGlobal   = (LlvmVar, Maybe LlvmStatic)
26 -- | A global constant variable
27 type LMConstant = (LlvmVar, LlvmStatic)
28 -- | A String in LLVM
29 type LMString   = FastString
30
31
32 -- | Llvm Types.
33 data LlvmType
34   = LMInt Int                 -- ^ An integer with a given width in bits.
35   | LMFloat                   -- ^ 32 bit floating point
36   | LMDouble                  -- ^ 64 bit floating point
37   | LMFloat80                 -- ^ 80 bit (x86 only) floating point
38   | LMFloat128                -- ^ 128 bit floating point
39   | LMPointer LlvmType        -- ^ A pointer to a 'LlvmType'
40   | LMArray Int LlvmType      -- ^ An array of 'LlvmType'
41   | LMLabel                   -- ^ A 'LlvmVar' can represent a label (address)
42   | LMVoid                    -- ^ Void type
43   | LMStruct [LlvmType]       -- ^ Structure type
44   | LMAlias LMString LlvmType -- ^ A type alias
45
46   -- | Function type, used to create pointers to functions
47   | LMFunction LlvmFunctionDecl
48   deriving (Eq)
49
50 instance Show LlvmType where
51   show (LMInt size    ) = "i" ++ show size
52   show (LMFloat       ) = "float"
53   show (LMDouble      ) = "double"
54   show (LMFloat80     ) = "x86_fp80"
55   show (LMFloat128    ) = "fp128"
56   show (LMPointer x   ) = show x ++ "*"
57   show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
58   show (LMLabel       ) = "label"
59   show (LMVoid        ) = "void"
60   show (LMStruct tys  ) = "{" ++ (commaCat tys) ++ "}"
61
62   show (LMFunction (LlvmFunctionDecl _ _ _ r VarArgs p _))
63         = show r ++ " (" ++ (either commaCat commaCat p) ++ ", ...)"
64   show (LMFunction (LlvmFunctionDecl _ _ _ r FixedArgs p _))
65         = show r ++ " (" ++ (either commaCat commaCat p) ++ ")"
66
67   show (LMAlias s _   ) = "%" ++ unpackFS s
68
69 -- | An LLVM section defenition. If Nothing then let LLVM decide the section
70 type LMSection = Maybe LMString
71 type LMAlign = Maybe Int
72
73 -- | Llvm Variables
74 data LlvmVar
75   -- | Variables with a global scope.
76   = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign
77   -- | Variables local to a function or parameters.
78   | LMLocalVar Unique LlvmType
79   -- | Named local variables. Sometimes we need to be able to explicitly name
80   -- variables (e.g for function arguments).
81   | LMNLocalVar LMString LlvmType
82   -- | A constant variable
83   | LMLitVar LlvmLit
84   deriving (Eq)
85
86 instance Show LlvmVar where
87   show (LMLitVar x) = show x
88   show (x         ) = show (getVarType x) ++ " " ++ getName x
89
90
91 -- | Llvm Literal Data.
92 --
93 -- These can be used inline in expressions.
94 data LlvmLit
95   -- | Refers to an integer constant (i64 42).
96   = LMIntLit Integer LlvmType
97   -- | Floating point literal
98   | LMFloatLit Double LlvmType
99   deriving (Eq)
100
101 instance Show LlvmLit where
102   show l = show (getLitType l) ++ " " ++ getLit l
103
104
105 -- | Llvm Static Data.
106 --
107 -- These represent the possible global level variables and constants.
108 data LlvmStatic
109   = LMComment LMString                  -- ^ A comment in a static section
110   | LMStaticLit LlvmLit                 -- ^ A static variant of a literal value
111   | LMUninitType LlvmType               -- ^ For uninitialised data
112   | LMStaticStr LMString LlvmType       -- ^ Defines a static 'LMString'
113   | LMStaticArray [LlvmStatic] LlvmType -- ^ A static array
114   | LMStaticStruc [LlvmStatic] LlvmType -- ^ A static structure type
115   | LMStaticPointer LlvmVar             -- ^ A pointer to other data
116
117   -- static expressions, could split out but leave
118   -- for moment for ease of use. Not many of them.
119
120   | LMBitc LlvmStatic LlvmType         -- ^ Pointer to Pointer conversion
121   | LMPtoI LlvmStatic LlvmType         -- ^ Pointer to Integer conversion
122   | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation
123   | LMSub LlvmStatic LlvmStatic        -- ^ Constant subtraction operation
124
125 instance Show LlvmStatic where
126   show (LMComment       s) = "; " ++ unpackFS s
127   show (LMStaticLit   l  ) = show l
128   show (LMUninitType    t) = show t ++ " undef"
129   show (LMStaticStr   s t) = show t ++ " c\"" ++ unpackFS s ++ "\\00\""
130
131   show (LMStaticArray d t)
132       = let struc = case d of
133               [] -> "[]"
134               ts -> "[" ++ show (head ts) ++
135                       concat (map (\x -> "," ++ show x) (tail ts)) ++ "]"
136         in show t ++ " " ++ struc
137
138   show (LMStaticStruc d t)
139       = let struc = case d of
140               [] -> "{}"
141               ts -> "{" ++ show (head ts) ++
142                       concat (map (\x -> "," ++ show x) (tail ts)) ++ "}"
143         in show t ++ " " ++ struc
144
145   show (LMStaticPointer v) = show v
146
147   show (LMBitc v t)
148       = show t ++ " bitcast (" ++ show v ++ " to " ++ show t ++ ")"
149
150   show (LMPtoI v t)
151       = show t ++ " ptrtoint (" ++ show v ++ " to " ++ show t ++ ")"
152
153   show (LMAdd s1 s2)
154       = let ty1 = getStatType s1
155         in if ty1 == getStatType s2
156                 then show ty1 ++ " add (" ++ show s1 ++ "," ++ show s2 ++ ")"
157                 else error $ "LMAdd with different types! s1: "
158                         ++ show s1 ++ ", s2: " ++ show s2
159   show (LMSub s1 s2)
160       = let ty1 = getStatType s1
161         in if ty1 == getStatType s2
162                 then show ty1 ++ " sub (" ++ show s1 ++ "," ++ show s2 ++ ")"
163                 else error $ "LMSub with different types! s1: "
164                         ++ show s1 ++ ", s2: " ++ show s2
165
166
167 -- | Concatenate an array together, separated by commas
168 commaCat :: Show a => [a] -> String
169 commaCat [] = ""
170 commaCat x  = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x))
171
172 -- -----------------------------------------------------------------------------
173 -- ** Operations on LLVM Basic Types and Variables
174 --
175
176 -- | Return the variable name or value of the 'LlvmVar'
177 -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
178 getName :: LlvmVar -> String
179 getName v@(LMGlobalVar _ _ _ _ _) = "@" ++ getPlainName v
180 getName v@(LMLocalVar  _ _      ) = "%" ++ getPlainName v
181 getName v@(LMNLocalVar _ _      ) = "%" ++ getPlainName v
182 getName v@(LMLitVar    _        ) = getPlainName v
183
184 -- | Return the variable name or value of the 'LlvmVar'
185 -- in a plain textual representation (e.g. @x@, @y@ or @42@).
186 getPlainName :: LlvmVar -> String
187 getPlainName (LMGlobalVar x _ _ _ _) = unpackFS x
188 getPlainName (LMLocalVar  x _      ) = show x
189 getPlainName (LMNLocalVar x _      ) = unpackFS x
190 getPlainName (LMLitVar    x        ) = getLit x
191
192 -- | Print a literal value. No type.
193 getLit :: LlvmLit -> String
194 getLit (LMIntLit   i _) = show ((fromInteger i)::Int)
195 getLit (LMFloatLit r _) = dToStr r
196
197 -- | Return the 'LlvmType' of the 'LlvmVar'
198 getVarType :: LlvmVar -> LlvmType
199 getVarType (LMGlobalVar _ y _ _ _) = y
200 getVarType (LMLocalVar  _ y      ) = y
201 getVarType (LMNLocalVar _ y      ) = y
202 getVarType (LMLitVar    l        ) = getLitType l
203
204 -- | Return the 'LlvmType' of a 'LlvmLit'
205 getLitType :: LlvmLit -> LlvmType
206 getLitType (LMIntLit   _ t) = t
207 getLitType (LMFloatLit _ t) = t
208
209 -- | Return the 'LlvmType' of the 'LlvmStatic'
210 getStatType :: LlvmStatic -> LlvmType
211 getStatType (LMStaticLit   l  ) = getLitType l
212 getStatType (LMUninitType    t) = t
213 getStatType (LMStaticStr   _ t) = t
214 getStatType (LMStaticArray _ t) = t
215 getStatType (LMStaticStruc _ t) = t
216 getStatType (LMStaticPointer v) = getVarType v
217 getStatType (LMBitc        _ t) = t
218 getStatType (LMPtoI        _ t) = t
219 getStatType (LMAdd         t _) = getStatType t
220 getStatType (LMSub         t _) = getStatType t
221 getStatType (LMComment       _) = error "Can't call getStatType on LMComment!"
222
223 -- | Return the 'LlvmType' of the 'LMGlobal'
224 getGlobalType :: LMGlobal -> LlvmType
225 getGlobalType (v, _) = getVarType v
226
227 -- | Return the 'LlvmVar' part of a 'LMGlobal'
228 getGlobalVar :: LMGlobal -> LlvmVar
229 getGlobalVar (v, _) = v
230
231 -- | Return the 'LlvmLinkageType' for a 'LlvmVar'
232 getLink :: LlvmVar -> LlvmLinkageType
233 getLink (LMGlobalVar _ _ l _ _) = l
234 getLink _                       = Internal
235
236 -- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
237 -- cannot be lifted.
238 pLift :: LlvmType -> LlvmType
239 pLift (LMLabel) = error "Labels are unliftable"
240 pLift (LMVoid)  = error "Voids are unliftable"
241 pLift x         = LMPointer x
242
243 -- | Lower a variable of 'LMPointer' type.
244 pVarLift :: LlvmVar -> LlvmVar
245 pVarLift (LMGlobalVar s t l x a) = LMGlobalVar s (pLift t) l x a
246 pVarLift (LMLocalVar  s t      ) = LMLocalVar  s (pLift t)
247 pVarLift (LMNLocalVar s t      ) = LMNLocalVar s (pLift t)
248 pVarLift (LMLitVar    _        ) = error $ "Can't lower a literal type!"
249
250 -- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
251 -- constructors can be lowered.
252 pLower :: LlvmType -> LlvmType
253 pLower (LMPointer x) = x
254 pLower x  = error $ show x ++ " is a unlowerable type, need a pointer"
255
256 -- | Lower a variable of 'LMPointer' type.
257 pVarLower :: LlvmVar -> LlvmVar
258 pVarLower (LMGlobalVar s t l x a) = LMGlobalVar s (pLower t) l x a
259 pVarLower (LMLocalVar  s t      ) = LMLocalVar  s (pLower t)
260 pVarLower (LMNLocalVar s t      ) = LMNLocalVar s (pLower t)
261 pVarLower (LMLitVar    _        ) = error $ "Can't lower a literal type!"
262
263 -- | Test if the given 'LlvmType' is an integer
264 isInt :: LlvmType -> Bool
265 isInt (LMInt _) = True
266 isInt _         = False
267
268 -- | Test if the given 'LlvmType' is a floating point type
269 isFloat :: LlvmType -> Bool
270 isFloat LMFloat    = True
271 isFloat LMDouble   = True
272 isFloat LMFloat80  = True
273 isFloat LMFloat128 = True
274 isFloat _          = False
275
276 -- | Test if the given 'LlvmType' is an 'LMPointer' construct
277 isPointer :: LlvmType -> Bool
278 isPointer (LMPointer _) = True
279 isPointer _             = False
280
281 -- | Test if a 'LlvmVar' is global.
282 isGlobal :: LlvmVar -> Bool
283 isGlobal (LMGlobalVar _ _ _ _ _) = True
284 isGlobal _                      = False
285
286 -- | Width in bits of an 'LlvmType', returns 0 if not applicable
287 llvmWidthInBits :: LlvmType -> Int
288 llvmWidthInBits (LMInt n)       = n
289 llvmWidthInBits (LMFloat)       = 32
290 llvmWidthInBits (LMDouble)      = 64
291 llvmWidthInBits (LMFloat80)     = 80
292 llvmWidthInBits (LMFloat128)    = 128
293 -- Could return either a pointer width here or the width of what
294 -- it points to. We will go with the former for now.
295 llvmWidthInBits (LMPointer _)   = llvmWidthInBits llvmWord
296 llvmWidthInBits (LMArray _ _)   = llvmWidthInBits llvmWord
297 llvmWidthInBits LMLabel         = 0
298 llvmWidthInBits LMVoid          = 0
299 llvmWidthInBits (LMStruct tys)  = sum $ map llvmWidthInBits tys
300 llvmWidthInBits (LMFunction  _) = 0
301 llvmWidthInBits (LMAlias _ t)   = llvmWidthInBits t
302
303
304 -- -----------------------------------------------------------------------------
305 -- ** Shortcut for Common Types
306 --
307
308 i128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType
309 i128  = LMInt 128
310 i64   = LMInt  64
311 i32   = LMInt  32
312 i16   = LMInt  16
313 i8    = LMInt   8
314 i1    = LMInt   1
315 i8Ptr = pLift i8
316
317 -- | The target architectures word size
318 llvmWord, llvmWordPtr :: LlvmType
319 llvmWord    = LMInt (wORD_SIZE * 8)
320 llvmWordPtr = pLift llvmWord
321
322 -- -----------------------------------------------------------------------------
323 -- * LLVM Function Types
324 --
325
326 -- | An LLVM Function
327 data LlvmFunctionDecl = LlvmFunctionDecl {
328         -- | Unique identifier of the function.
329         decName       :: LMString,
330         -- | LinkageType of the function.
331         funcLinkage   :: LlvmLinkageType,
332         -- | The calling convention of the function.
333         funcCc        :: LlvmCallConvention,
334         -- | Type of the returned value
335         decReturnType :: LlvmType,
336         -- | Indicates if this function uses varargs
337         decVarargs    :: LlvmParameterListType,
338         -- | Signature of the parameters, can be just types or full vars
339         -- if parameter names are required.
340         decParams     :: Either [LlvmType] [LlvmVar],
341         -- | Function align value, must be power of 2
342         funcAlign     :: LMAlign
343   }
344   deriving (Eq)
345
346 instance Show LlvmFunctionDecl where
347   show (LlvmFunctionDecl n l c r varg p a)
348     = let varg' = if varg == VarArgs then ", ..." else ""
349           align = case a of
350                        Just a' -> " align " ++ show a'
351                        Nothing -> ""
352     in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
353         "(" ++ (either commaCat commaCat p) ++ varg' ++ ")" ++ align
354
355 type LlvmFunctionDecls = [LlvmFunctionDecl]
356
357
358 -- | Llvm Function Attributes.
359 --
360 -- Function attributes are set to communicate additional information about a
361 -- function. Function attributes are considered to be part of the function,
362 -- not of the function type, so functions with different parameter attributes
363 -- can have the same function type. Functions can have multiple attributes.
364 --
365 -- Descriptions taken from <http://llvm.org/docs/LangRef.html#fnattrs>
366 data LlvmFuncAttr
367   -- | This attribute indicates that the inliner should attempt to inline this
368   -- function into callers whenever possible, ignoring any active inlining
369   -- size threshold for this caller.
370   = AlwaysInline
371   -- | This attribute indicates that the source code contained a hint that
372   -- inlining this function is desirable (such as the \"inline\" keyword in
373   -- C/C++). It is just a hint; it imposes no requirements on the inliner.
374   | InlineHint
375   -- | This attribute indicates that the inliner should never inline this
376   -- function in any situation. This attribute may not be used together
377   -- with the alwaysinline attribute.
378   | NoInline
379   -- | This attribute suggests that optimization passes and code generator
380   -- passes make choices that keep the code size of this function low, and
381   -- otherwise do optimizations specifically to reduce code size.
382   | OptSize
383   -- | This function attribute indicates that the function never returns
384   -- normally. This produces undefined behavior at runtime if the function
385   -- ever does dynamically return.
386   | NoReturn
387   -- | This function attribute indicates that the function never returns with
388   -- an unwind or exceptional control flow. If the function does unwind, its
389   -- runtime behavior is undefined.
390   | NoUnwind
391   -- | This attribute indicates that the function computes its result (or
392   -- decides to unwind an exception) based strictly on its arguments, without
393   -- dereferencing any pointer arguments or otherwise accessing any mutable
394   -- state (e.g. memory, control registers, etc) visible to caller functions.
395   -- It does not write through any pointer arguments (including byval
396   -- arguments) and never changes any state visible to callers. This means
397   -- that it cannot unwind exceptions by calling the C++ exception throwing
398   -- methods, but could use the unwind instruction.
399   | ReadNone
400   -- | This attribute indicates that the function does not write through any
401   -- pointer arguments (including byval arguments) or otherwise modify any
402   -- state (e.g. memory, control registers, etc) visible to caller functions.
403   -- It may dereference pointer arguments and read state that may be set in
404   -- the caller. A readonly function always returns the same value (or unwinds
405   -- an exception identically) when called with the same set of arguments and
406   -- global state. It cannot unwind an exception by calling the C++ exception
407   -- throwing methods, but may use the unwind instruction.
408   | ReadOnly
409   -- | This attribute indicates that the function should emit a stack smashing
410   -- protector. It is in the form of a \"canary\"—a random value placed on the
411   -- stack before the local variables that's checked upon return from the
412   -- function to see if it has been overwritten. A heuristic is used to
413   -- determine if a function needs stack protectors or not.
414   --
415   -- If a function that has an ssp attribute is inlined into a function that
416   -- doesn't have an ssp attribute, then the resulting function will have an
417   -- ssp attribute.
418   | Ssp
419   -- | This attribute indicates that the function should always emit a stack
420   -- smashing protector. This overrides the ssp function attribute.
421   --
422   -- If a function that has an sspreq attribute is inlined into a function
423   -- that doesn't have an sspreq attribute or which has an ssp attribute,
424   -- then the resulting function will have an sspreq attribute.
425   | SspReq
426   -- | This attribute indicates that the code generator should not use a red
427   -- zone, even if the target-specific ABI normally permits it.
428   | NoRedZone
429   -- | This attributes disables implicit floating point instructions.
430   | NoImplicitFloat
431   -- | This attribute disables prologue / epilogue emission for the function.
432   -- This can have very system-specific consequences.
433   | Naked
434   deriving (Eq)
435
436 instance Show LlvmFuncAttr where
437   show AlwaysInline       = "alwaysinline"
438   show InlineHint         = "inlinehint"
439   show NoInline           = "noinline"
440   show OptSize            = "optsize"
441   show NoReturn           = "noreturn"
442   show NoUnwind           = "nounwind"
443   show ReadNone           = "readnon"
444   show ReadOnly           = "readonly"
445   show Ssp                = "ssp"
446   show SspReq             = "ssqreq"
447   show NoRedZone          = "noredzone"
448   show NoImplicitFloat    = "noimplicitfloat"
449   show Naked              = "naked"
450
451
452 -- | Different types to call a function.
453 data LlvmCallType
454   -- | Normal call, allocate a new stack frame.
455   = StdCall
456   -- | Tail call, perform the call in the current stack frame.
457   | TailCall
458   deriving (Eq,Show)
459
460 -- | Different calling conventions a function can use.
461 data LlvmCallConvention
462   -- | The C calling convention.
463   -- This calling convention (the default if no other calling convention is
464   -- specified) matches the target C calling conventions. This calling
465   -- convention supports varargs function calls and tolerates some mismatch in
466   -- the declared prototype and implemented declaration of the function (as
467   -- does normal C).
468   = CC_Ccc
469   -- | This calling convention attempts to make calls as fast as possible
470   -- (e.g. by passing things in registers). This calling convention allows
471   -- the target to use whatever tricks it wants to produce fast code for the
472   -- target, without having to conform to an externally specified ABI
473   -- (Application Binary Interface). Implementations of this convention should
474   -- allow arbitrary tail call optimization to be supported. This calling
475   -- convention does not support varargs and requires the prototype of al
476   -- callees to exactly match the prototype of the function definition.
477   | CC_Fastcc
478   -- | This calling convention attempts to make code in the caller as efficient
479   -- as possible under the assumption that the call is not commonly executed.
480   -- As such, these calls often preserve all registers so that the call does
481   -- not break any live ranges in the caller side. This calling convention
482   -- does not support varargs and requires the prototype of all callees to
483   -- exactly match the prototype of the function definition.
484   | CC_Coldcc
485   -- | Any calling convention may be specified by number, allowing
486   -- target-specific calling conventions to be used. Target specific calling
487   -- conventions start at 64.
488   | CC_Ncc Int
489   -- | X86 Specific 'StdCall' convention. LLVM includes a specific alias for it
490   -- rather than just using CC_Ncc.
491   | CC_X86_Stdcc
492   deriving (Eq)
493
494 instance Show LlvmCallConvention where
495   show CC_Ccc       = "ccc"
496   show CC_Fastcc    = "fastcc"
497   show CC_Coldcc    = "coldcc"
498   show (CC_Ncc i)   = "cc " ++ show i
499   show CC_X86_Stdcc = "x86_stdcallcc"
500
501
502 -- | Functions can have a fixed amount of parameters, or a variable amount.
503 data LlvmParameterListType
504   -- Fixed amount of arguments.
505   = FixedArgs
506   -- Variable amount of arguments.
507   | VarArgs
508   deriving (Eq,Show)
509
510
511 -- | Linkage type of a symbol.
512 --
513 -- The description of the constructors is copied from the Llvm Assembly Language
514 -- Reference Manual <http://www.llvm.org/docs/LangRef.html#linkage>, because
515 -- they correspond to the Llvm linkage types.
516 data LlvmLinkageType
517   -- | Global values with internal linkage are only directly accessible by
518   -- objects in the current module. In particular, linking code into a module
519   -- with an internal global value may cause the internal to be renamed as
520   -- necessary to avoid collisions. Because the symbol is internal to the
521   -- module, all references can be updated. This corresponds to the notion
522   -- of the @static@ keyword in C.
523   = Internal
524   -- | Globals with @linkonce@ linkage are merged with other globals of the
525   -- same name when linkage occurs. This is typically used to implement
526   -- inline functions, templates, or other code which must be generated
527   -- in each translation unit that uses it. Unreferenced linkonce globals are
528   -- allowed to be discarded.
529   | LinkOnce
530   -- | @weak@ linkage is exactly the same as linkonce linkage, except that
531   -- unreferenced weak globals may not be discarded. This is used for globals
532   -- that may be emitted in multiple translation units, but that are not
533   -- guaranteed to be emitted into every translation unit that uses them. One
534   -- example of this are common globals in C, such as @int X;@ at global
535   -- scope.
536   | Weak
537   -- | @appending@ linkage may only be applied to global variables of pointer
538   -- to array type. When two global variables with appending linkage are
539   -- linked together, the two global arrays are appended together. This is
540   -- the Llvm, typesafe, equivalent of having the system linker append
541   -- together @sections@ with identical names when .o files are linked.
542   | Appending
543   -- | The semantics of this linkage follow the ELF model: the symbol is weak
544   -- until linked, if not linked, the symbol becomes null instead of being an
545   -- undefined reference.
546   | ExternWeak
547   -- | The symbol participates in linkage and can be used to resolve external
548   --  symbol references.
549   | ExternallyVisible
550   -- | Alias for 'ExternallyVisible' but with explicit textual form in LLVM
551   --  assembly.
552   | External
553   deriving (Eq)
554
555 instance Show LlvmLinkageType where
556   show Internal          = "internal"
557   show LinkOnce          = "linkonce"
558   show Weak              = "weak"
559   show Appending         = "appending"
560   show ExternWeak        = "extern_weak"
561   -- ExternallyVisible does not have a textual representation, it is
562   -- the linkage type a function resolves to if no other is specified
563   -- in Llvm.
564   show ExternallyVisible = ""
565   show External          = "external"
566
567
568 -- -----------------------------------------------------------------------------
569 -- * LLVM Operations
570 --
571
572 -- | Llvm binary operators machine operations.
573 data LlvmMachOp
574   = LM_MO_Add  -- ^ add two integer, floating point or vector values.
575   | LM_MO_Sub  -- ^ subtract two ...
576   | LM_MO_Mul  -- ^ multiply ..
577   | LM_MO_UDiv -- ^ unsigned integer or vector division.
578   | LM_MO_SDiv -- ^ signed integer ..
579   | LM_MO_FDiv -- ^ floating point ..
580   | LM_MO_URem -- ^ unsigned integer or vector remainder (mod)
581   | LM_MO_SRem -- ^ signed ...
582   | LM_MO_FRem -- ^ floating point ...
583
584   -- | Left shift
585   | LM_MO_Shl
586   -- | Logical shift right
587   -- Shift right, filling with zero
588   | LM_MO_LShr
589   -- | Arithmetic shift right
590   -- The most significant bits of the result will be equal to the sign bit of
591   -- the left operand.
592   | LM_MO_AShr
593
594   | LM_MO_And -- ^ AND bitwise logical operation.
595   | LM_MO_Or  -- ^ OR bitwise logical operation.
596   | LM_MO_Xor -- ^ XOR bitwise logical operation.
597   deriving (Eq)
598
599 instance Show LlvmMachOp where
600   show LM_MO_Add  = "add"
601   show LM_MO_Sub  = "sub"
602   show LM_MO_Mul  = "mul"
603   show LM_MO_UDiv = "udiv"
604   show LM_MO_SDiv = "sdiv"
605   show LM_MO_FDiv = "fdiv"
606   show LM_MO_URem = "urem"
607   show LM_MO_SRem = "srem"
608   show LM_MO_FRem = "frem"
609   show LM_MO_Shl  = "shl"
610   show LM_MO_LShr = "lshr"
611   show LM_MO_AShr = "ashr"
612   show LM_MO_And  = "and"
613   show LM_MO_Or   = "or"
614   show LM_MO_Xor  = "xor"
615
616
617 -- | Llvm compare operations.
618 data LlvmCmpOp
619   = LM_CMP_Eq  -- ^ Equal (Signed and Unsigned)
620   | LM_CMP_Ne  -- ^ Not equal (Signed and Unsigned)
621   | LM_CMP_Ugt -- ^ Unsigned greater than
622   | LM_CMP_Uge -- ^ Unsigned greater than or equal
623   | LM_CMP_Ult -- ^ Unsigned less than
624   | LM_CMP_Ule -- ^ Unsigned less than or equal
625   | LM_CMP_Sgt -- ^ Signed greater than
626   | LM_CMP_Sge -- ^ Signed greater than or equal
627   | LM_CMP_Slt -- ^ Signed less than
628   | LM_CMP_Sle -- ^ Signed less than or equal
629
630   -- Float comparisons. GHC uses a mix of ordered and unordered float
631   -- comparisons.
632   | LM_CMP_Feq -- ^ Float equal
633   | LM_CMP_Fne -- ^ Float not equal
634   | LM_CMP_Fgt -- ^ Float greater than
635   | LM_CMP_Fge -- ^ Float greater than or equal
636   | LM_CMP_Flt -- ^ Float less than
637   | LM_CMP_Fle -- ^ Float less than or equal
638   deriving (Eq)
639
640 instance Show LlvmCmpOp where
641   show LM_CMP_Eq  = "eq"
642   show LM_CMP_Ne  = "ne"
643   show LM_CMP_Ugt = "ugt"
644   show LM_CMP_Uge = "uge"
645   show LM_CMP_Ult = "ult"
646   show LM_CMP_Ule = "ule"
647   show LM_CMP_Sgt = "sgt"
648   show LM_CMP_Sge = "sge"
649   show LM_CMP_Slt = "slt"
650   show LM_CMP_Sle = "sle"
651   show LM_CMP_Feq = "oeq"
652   show LM_CMP_Fne = "une"
653   show LM_CMP_Fgt = "ogt"
654   show LM_CMP_Fge = "oge"
655   show LM_CMP_Flt = "olt"
656   show LM_CMP_Fle = "ole"
657
658
659 -- | Llvm cast operations.
660 data LlvmCastOp
661   = LM_Trunc    -- ^ Integer truncate
662   | LM_Zext     -- ^ Integer extend (zero fill)
663   | LM_Sext     -- ^ Integer extend (sign fill)
664   | LM_Fptrunc  -- ^ Float truncate
665   | LM_Fpext    -- ^ Float extend
666   | LM_Fptoui   -- ^ Float to unsigned Integer
667   | LM_Fptosi   -- ^ Float to signed Integer
668   | LM_Uitofp   -- ^ Unsigned Integer to Float
669   | LM_Sitofp   -- ^ Signed Int to Float
670   | LM_Ptrtoint -- ^ Pointer to Integer
671   | LM_Inttoptr -- ^ Integer to Pointer
672   | LM_Bitcast  -- ^ Cast between types where no bit manipulation is needed
673   deriving (Eq)
674
675 instance Show LlvmCastOp where
676   show LM_Trunc    = "trunc"
677   show LM_Zext     = "zext"
678   show LM_Sext     = "sext"
679   show LM_Fptrunc  = "fptrunc"
680   show LM_Fpext    = "fpext"
681   show LM_Fptoui   = "fptoui"
682   show LM_Fptosi   = "fptosi"
683   show LM_Uitofp   = "uitofp"
684   show LM_Sitofp   = "sitofp"
685   show LM_Ptrtoint = "ptrtoint"
686   show LM_Inttoptr = "inttoptr"
687   show LM_Bitcast  = "bitcast"
688
689
690 -- -----------------------------------------------------------------------------
691 -- * Floating point conversion
692 --
693
694 -- | Convert a Haskell Double to an LLVM hex encoded floating point form. In
695 -- Llvm float literals can be printed in a big-endian hexadecimal format,
696 -- regardless of underlying architecture.
697 dToStr :: Double -> String
698 dToStr d
699   = let bs     = doubleToBytes d
700         hex d' = case showHex d' "" of
701                      []    -> error "dToStr: too few hex digits for float"
702                      [x]   -> ['0',x]
703                      [x,y] -> [x,y]
704                      _     -> error "dToStr: too many hex digits for float"
705
706         str  = map toUpper $ concat . fixEndian . (map hex) $ bs
707     in  "0x" ++ str
708
709 -- | Reverse or leave byte data alone to fix endianness on this target.
710 fixEndian :: [a] -> [a]
711 #ifdef WORDS_BIGENDIAN
712 fixEndian = id
713 #else
714 fixEndian = reverse
715 #endif
716