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