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