{-# LINE 1 "LLVM/FFI/Core.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable #-}
{-# LINE 2 "LLVM/FFI/Core.hsc" #-}

-- |
-- Module:      LLVM.FFI.Core
-- Copyright:   Bryan O'Sullivan 2007, 2008
-- License:     BSD-style (see the file LICENSE)
--
-- Maintainer:  bos@serpentine.com
-- Stability:   experimental
-- Portability: requires GHC 6.8, LLVM
--
-- This module provides direct access to the LLVM C bindings.

module LLVM.FFI.Core
    (
      -- * Modules
      Module
    , ModuleRef
    , moduleCreateWithName
    , disposeModule
    , ptrDisposeModule

    , getDataLayout
    , setDataLayout

    , getTarget
    , setTarget

    -- * Module providers
    , ModuleProvider
    , ModuleProviderRef
    , createModuleProviderForExistingModule
    , ptrDisposeModuleProvider

    -- * Types
    , Type
    , TypeRef
    , addTypeName
    , deleteTypeName

    , getTypeKind
    , TypeKind(..)

    -- ** Integer types
    , int1Type
    , int8Type
    , int16Type
    , int32Type
    , int64Type
    , integerType
    , getIntTypeWidth

    -- ** Real types
    , floatType
    , doubleType
    , x86FP80Type
    , fp128Type
    , ppcFP128Type

    -- ** Function types
    , functionType
    , isFunctionVarArg
    , getReturnType
    , countParamTypes
    , getParamTypes

    -- ** Other types
    , voidType
    , labelType
    , opaqueType

    -- ** Array, pointer, and vector types
    , arrayType
    , pointerType
    , vectorType
    , getElementType
    , getArrayLength
    , getPointerAddressSpace
    , getVectorSize

    -- ** Struct types
    , structType
    , countStructElementTypes
    , getStructElementTypes
    , isPackedStruct

    -- * Type handles
    , createTypeHandle
    , refineType
    , resolveTypeHandle
    , disposeTypeHandle

    -- * Values
    , Value
    , ValueRef
    , typeOf
    , getValueName
    , setValueName
    , dumpValue

    -- ** Constants
    , constNull
    , constAllOnes
    , getUndef
    , isConstant
    , isNull
    , isUndef

    -- ** Global variables, functions, and aliases (globals)
    , Linkage(..)
    , fromLinkage
    , toLinkage
    , getLinkage
    , setLinkage

    , Visibility(..)
    , fromVisibility
    , toVisibility
    , getVisibility
    , setVisibility

    , isDeclaration
    , getSection
    , setSection
    , getAlignment
    , setAlignment
      
    -- ** Global variables
    , addGlobal
    , getNamedGlobal
    , deleteGlobal
    , getInitializer
    , setInitializer
    , isThreadLocal
    , setThreadLocal
    , isGlobalConstant
    , setGlobalConstant
    , getFirstGlobal
    , getNextGlobal
    , getPreviousGlobal
    , getLastGlobal
    , getGlobalParent

    -- ** Functions
    , addFunction
    , getNamedFunction
    , deleteFunction
    , countParams
    , getParams
    , getParam
    , getIntrinsicID
    , getGC
    , setGC
    , getFirstFunction
    , getNextFunction
    , getPreviousFunction
    , getLastFunction
    , getFirstParam
    , getNextParam
    , getPreviousParam
    , getLastParam
    , getParamParent
    , isTailCall
    , setTailCall

    -- ** Phi nodes
    , addIncoming
    , countIncoming
    , getIncomingValue
    , getIncomingBlock

    -- ** Calling conventions
    , CallingConvention(..)
    , fromCallingConvention
    , toCallingConvention
    , getFunctionCallConv
    , setFunctionCallConv
    , getInstructionCallConv
    , setInstructionCallConv

    -- * Constants

    -- ** Scalar constants
    , constInt
    , constReal

    -- ** Composite constants
    , constArray
    , constString
    , constStruct
    , constVector

    -- ** Constant expressions
    , sizeOf
    , constNeg
    , constNot
    , constAdd
    , constSub
    , constMul
    , constExactSDiv
    , constFAdd
    , constFMul
    , constFNeg
    , constFPCast
    , constFSub
    , constUDiv
    , constSDiv
    , constFDiv
    , constURem
    , constSRem
    , constFRem
    , constAnd
    , constOr
    , constXor
    , constICmp
    , constFCmp
    , constShl
    , constLShr
    , constAShr
    , constGEP
    , constTrunc
    , constSExt
    , constZExt
    , constFPTrunc
    , constFPExt
    , constUIToFP
    , constSIToFP
    , constFPToUI
    , constFPToSI
    , constPtrToInt
    , constIntToPtr
    , constBitCast
    , constSelect
    , constExtractElement
    , constInsertElement
    , constShuffleVector
    , constExtractValue
    , constInsertValue
    , constRealOfString

    -- * Basic blocks
    , BasicBlock
    , BasicBlockRef
    , basicBlockAsValue
    , valueIsBasicBlock
    , valueAsBasicBlock
    , countBasicBlocks
    , getBasicBlocks
    , getEntryBasicBlock
    , appendBasicBlock
    , insertBasicBlock
    , deleteBasicBlock
    , getFirstBasicBlock
    , getNextBasicBlock
    , getPreviousBasicBlock
    , getLastBasicBlock
    , getInsertBlock
    , getBasicBlockParent

    -- * Instruction building
    , Builder
    , BuilderRef
    , createBuilder
    , ptrDisposeBuilder
    , positionBuilder
    , positionBefore
    , positionAtEnd
    , getFirstInstruction
    , getNextInstruction
    , getPreviousInstruction
    , getLastInstruction
    , getInstructionParent

    -- ** Terminators
    , buildRetVoid
    , buildRet
    , buildBr
    , buildCondBr
    , buildSwitch
    , buildInvoke
    , buildUnwind
    , buildUnreachable

    -- ** Arithmetic
    , buildAdd
    , buildSub
    , buildMul
    , buildFAdd
    , buildFMul
    , buildFPCast
    , buildFSub
    , buildUDiv
    , buildSDiv
    , buildExactSDiv
    , buildFDiv
    , buildURem
    , buildSRem
    , buildFRem
    , buildShl
    , buildLShr
    , buildAShr
    , buildAnd
    , buildOr
    , buildXor
    , buildNeg
    , buildNot

    -- ** Memory
    , buildMalloc
    , buildArrayMalloc
    , buildAlloca
    , buildArrayAlloca
    , buildFree
    , buildLoad
    , buildStore
    , buildGEP

    -- ** Casts
    , buildTrunc
    , buildZExt
    , buildSExt
    , buildFPToUI
    , buildFPToSI
    , buildUIToFP
    , buildSIToFP
    , buildFPTrunc
    , buildFPExt
    , buildPtrToInt
    , buildIntToPtr
    , buildBitCast
    , buildPointerCast
    , buildTruncOrBitCast
    , buildZExtOrBitCast
    , buildSExtOrBitCast

    , buildPtrDiff

    -- * Misc
    , buildAggregateRet
    , buildGlobalString
    , buildGlobalStringPtr
    , buildInBoundsGEP
    , buildIntCast
    , buildIsNotNull
    , buildIsNull
    , buildNSWAdd
    , buildStructGEP

    -- ** Comparisons
    , buildICmp
    , buildFCmp

    -- ** Miscellaneous instructions
    , buildPhi
    , buildCall
    , buildSelect
    , buildVAArg
    , buildExtractElement
    , buildInsertElement
    , buildShuffleVector
    , buildExtractValue
    , buildInsertValue

    -- ** Other helpers
    , addCase

    -- * Memory buffers
    , MemoryBuffer
    , MemoryBufferRef
    , createMemoryBufferWithContentsOfFile
    , createMemoryBufferWithSTDIN
    , disposeMemoryBuffer

    -- * Error handling
    , disposeMessage

    -- * Parameter passing
    , addAttribute
    , setInstrParamAlignment
    , setParamAlignment
    , Attribute(..)
    , fromAttribute
    , toAttribute
    , addInstrAttribute
    , removeFunctionAttr
    , removeAttribute
    , removeInstrAttribute
    , addFunctionAttr

    -- * Pass manager
    , PassManager
    , PassManagerRef
    , createFunctionPassManager
    , createPassManager
    , ptrDisposePassManager
    , finalizeFunctionPassManager
    , initializeFunctionPassManager
    , runFunctionPassManager
    , runPassManager

    -- * Context functions
    , Context
    , ContextRef

    -- * Debug
    , dumpModule


    -- * Misc
    , alignOf
    , constInBoundsGEP
    , constIntCast
    , constIntOfString
    , constIntOfStringAndSize
    , constNSWAdd
    , constPointerCast
    , constPointerNull
    , constRealOfStringAndSize
    , constSExtOrBitCast

    , getTypeByName
    , insertIntoBuilderWithName

    -- * Context functions
    , moduleCreateWithNameInContext
    , appendBasicBlockInContext
    , insertBasicBlockInContext
    , createBuilderInContext

    , contextDispose

    , constStringInContext
    , constStructInContext
    , constTruncOrBitCast
    , constZExtOrBitCast

    , doubleTypeInContext
    , fP128TypeInContext
    , floatTypeInContext
    , int16TypeInContext
    , int1TypeInContext
    , int32TypeInContext
    , int64TypeInContext
    , int8TypeInContext
    , intTypeInContext
    , labelTypeInContext
    , opaqueTypeInContext
    , pPCFP128TypeInContext
    , structTypeInContext
    , voidTypeInContext
    , x86FP80TypeInContext
    , getTypeContext

    ) where
import Data.Typeable(Typeable)
import Foreign.C.String (CString)
import Foreign.C.Types (CDouble, CInt, CUInt, CULLong)
import Foreign.Ptr (Ptr, FunPtr)


{-# LINE 461 "LLVM/FFI/Core.hsc" #-}

data Module
    deriving (Typeable)
type ModuleRef = Ptr Module

foreign import ccall unsafe "LLVMModuleCreateWithName" moduleCreateWithName
    :: CString -> IO ModuleRef

foreign import ccall unsafe "LLVMDisposeModule" disposeModule
    :: ModuleRef -> IO ()

foreign import ccall unsafe "&LLVMDisposeModule" ptrDisposeModule
    :: FunPtr (ModuleRef -> IO ())

foreign import ccall unsafe "LLVMGetDataLayout" getDataLayout
    :: ModuleRef -> IO CString

foreign import ccall unsafe "LLVMSetDataLayout" setDataLayout
    :: ModuleRef -> CString -> IO ()


data ModuleProvider
    deriving (Typeable)
type ModuleProviderRef = Ptr ModuleProvider

foreign import ccall unsafe "LLVMCreateModuleProviderForExistingModule"
    createModuleProviderForExistingModule
    :: ModuleRef -> IO ModuleProviderRef

foreign import ccall unsafe "&LLVMDisposeModuleProvider" ptrDisposeModuleProvider
    :: FunPtr (ModuleProviderRef -> IO ())


data Type
    deriving (Typeable)
type TypeRef = Ptr Type

foreign import ccall unsafe "LLVMInt1Type" int1Type :: TypeRef

foreign import ccall unsafe "LLVMInt8Type" int8Type :: TypeRef

foreign import ccall unsafe "LLVMInt16Type" int16Type :: TypeRef

foreign import ccall unsafe "LLVMInt32Type" int32Type :: TypeRef

foreign import ccall unsafe "LLVMInt64Type" int64Type :: TypeRef

-- | An integer type of the given width.
foreign import ccall unsafe "LLVMIntType" integerType
    :: CUInt                    -- ^ width in bits
    -> TypeRef

foreign import ccall unsafe "LLVMFloatType" floatType :: TypeRef

foreign import ccall unsafe "LLVMDoubleType" doubleType :: TypeRef

foreign import ccall unsafe "LLVMX86FP80Type" x86FP80Type :: TypeRef

foreign import ccall unsafe "LLVMFP128Type" fp128Type :: TypeRef

foreign import ccall unsafe "LLVMPPCFP128Type" ppcFP128Type :: TypeRef

foreign import ccall unsafe "LLVMVoidType" voidType :: TypeRef

-- | Create a function type.
foreign import ccall unsafe "LLVMFunctionType" functionType
        :: TypeRef              -- ^ return type
        -> Ptr TypeRef          -- ^ array of argument types
        -> CUInt                -- ^ number of elements in array
        -> CInt                 -- ^ non-zero if function is varargs
        -> TypeRef

-- | Indicate whether a function takes varargs.
foreign import ccall unsafe "LLVMIsFunctionVarArg" isFunctionVarArg
        :: TypeRef -> IO CInt

-- | Give a function's return type.
foreign import ccall unsafe "LLVMGetReturnType" getReturnType
        :: TypeRef -> IO TypeRef

-- | Give the number of fixed parameters that a function takes.
foreign import ccall unsafe "LLVMCountParamTypes" countParamTypes
        :: TypeRef -> IO CUInt

-- | Fill out an array with the types of a function's fixed
-- parameters.
foreign import ccall unsafe "LLVMGetParamTypes" getParamTypes
        :: TypeRef -> Ptr TypeRef -> IO ()

foreign import ccall unsafe "LLVMArrayType" arrayType
    :: TypeRef                  -- ^ element type
    -> CUInt                    -- ^ element count
    -> TypeRef

foreign import ccall unsafe "LLVMPointerType" pointerType
    :: TypeRef                  -- ^ pointed-to type
    -> CUInt                    -- ^ address space
    -> TypeRef

foreign import ccall unsafe "LLVMVectorType" vectorType
    :: TypeRef                  -- ^ element type
    -> CUInt                    -- ^ element count
    -> TypeRef

foreign import ccall unsafe "LLVMAddTypeName" addTypeName
    :: ModuleRef -> CString -> TypeRef -> IO CInt

foreign import ccall unsafe "LLVMDeleteTypeName" deleteTypeName
    :: ModuleRef -> CString -> IO ()

-- | Get the type of a sequential type's elements.
foreign import ccall unsafe "LLVMGetElementType" getElementType
    :: TypeRef -> IO TypeRef


data Value
    deriving (Typeable)
type ValueRef = Ptr Value

foreign import ccall unsafe "LLVMAddGlobal" addGlobal
    :: ModuleRef -> TypeRef -> CString -> IO ValueRef

foreign import ccall unsafe "LLVMDeleteGlobal" deleteGlobal
    :: ValueRef -> IO ()

foreign import ccall unsafe "LLVMSetInitializer" setInitializer
    :: ValueRef -> ValueRef -> IO ()

foreign import ccall unsafe "LLVMGetNamedGlobal" getNamedGlobal
    :: ModuleRef -> CString -> IO ValueRef

foreign import ccall unsafe "LLVMGetInitializer" getInitializer
    :: ValueRef -> IO ValueRef

foreign import ccall unsafe "LLVMIsThreadLocal" isThreadLocal
    :: ValueRef -> IO CInt

foreign import ccall unsafe "LLVMSetThreadLocal" setThreadLocal
    :: ValueRef -> CInt -> IO ()

foreign import ccall unsafe "LLVMIsGlobalConstant" isGlobalConstant
    :: ValueRef -> IO CInt

foreign import ccall unsafe "LLVMSetGlobalConstant" setGlobalConstant
    :: ValueRef -> CInt -> IO ()

foreign import ccall unsafe "LLVMTypeOf" typeOf
    :: ValueRef -> IO TypeRef

foreign import ccall unsafe "LLVMGetValueName" getValueName
    :: ValueRef -> IO CString

foreign import ccall unsafe "LLVMSetValueName" setValueName
    :: ValueRef -> CString -> IO ()

foreign import ccall unsafe "LLVMDumpValue" dumpValue
    :: ValueRef -> IO ()

foreign import ccall unsafe "LLVMConstAllOnes" constAllOnes
    :: TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstArray" constArray
    :: TypeRef -> Ptr ValueRef -> CUInt -> ValueRef

foreign import ccall unsafe "LLVMConstNull" constNull
    :: TypeRef -> ValueRef

foreign import ccall unsafe "LLVMIsConstant" isConstant
    :: ValueRef -> IO CInt

foreign import ccall unsafe "LLVMGetUndef" getUndef
    :: TypeRef -> ValueRef

foreign import ccall unsafe "LLVMIsNull" isNull
    :: ValueRef -> IO CInt

foreign import ccall unsafe "LLVMIsUndef" isUndef
    :: ValueRef -> IO CInt

foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction
    :: ModuleRef                -- ^ module
    -> CString                  -- ^ name
    -> IO ValueRef              -- ^ function (@nullPtr@ if not found)

foreign import ccall unsafe "LLVMAddFunction" addFunction
    :: ModuleRef                -- ^ module
    -> CString                  -- ^ name
    -> TypeRef                  -- ^ type
    -> IO ValueRef

foreign import ccall unsafe "LLVMDeleteFunction" deleteFunction
    :: ValueRef                 -- ^ function
    -> IO ()

foreign import ccall unsafe "LLVMCountParams" countParams
    :: ValueRef                 -- ^ function
    -> CUInt

foreign import ccall unsafe "LLVMGetParam" getParam
    :: ValueRef                 -- ^ function
    -> CUInt                    -- ^ offset into array
    -> ValueRef

foreign import ccall unsafe "LLVMGetParams" getParams
    :: ValueRef                 -- ^ function
    -> Ptr ValueRef             -- ^ array to fill out
    -> IO ()

foreign import ccall unsafe "LLVMGetIntrinsicID" getIntrinsicID
    :: ValueRef                 -- ^ function
    -> CUInt

data CallingConvention = C
                       | Fast
                       | Cold
                       | X86StdCall
                       | X86FastCall
                         deriving (Show, Eq, Ord, Enum, Bounded, Typeable)

fromCallingConvention :: CallingConvention -> CUInt
fromCallingConvention C = (0)
{-# LINE 682 "LLVM/FFI/Core.hsc" #-}
fromCallingConvention Fast = (8)
{-# LINE 683 "LLVM/FFI/Core.hsc" #-}
fromCallingConvention Cold = (9)
{-# LINE 684 "LLVM/FFI/Core.hsc" #-}
fromCallingConvention X86StdCall = (65)
{-# LINE 685 "LLVM/FFI/Core.hsc" #-}
fromCallingConvention X86FastCall = (64)
{-# LINE 686 "LLVM/FFI/Core.hsc" #-}

toCallingConvention :: CUInt -> CallingConvention
toCallingConvention c | c == (0) = C
{-# LINE 689 "LLVM/FFI/Core.hsc" #-}
toCallingConvention c | c == (8) = Fast
{-# LINE 690 "LLVM/FFI/Core.hsc" #-}
toCallingConvention c | c == (9) = Cold
{-# LINE 691 "LLVM/FFI/Core.hsc" #-}
toCallingConvention c | c == (64) = X86StdCall
{-# LINE 692 "LLVM/FFI/Core.hsc" #-}
toCallingConvention c | c == (65) = X86FastCall
{-# LINE 693 "LLVM/FFI/Core.hsc" #-}
toCallingConvention c = error $ "LLVM.Core.FFI.toCallingConvention: " ++
                                "unsupported calling convention" ++ show c

foreign import ccall unsafe "LLVMGetFunctionCallConv" getFunctionCallConv
    :: ValueRef                 -- ^ function
    -> IO CUInt

foreign import ccall unsafe "LLVMSetFunctionCallConv" setFunctionCallConv
    :: ValueRef                 -- ^ function
    -> CUInt
    -> IO ()

foreign import ccall unsafe "LLVMGetGC" getGC
    :: ValueRef -> IO CString

foreign import ccall unsafe "LLVMSetGC" setGC
    :: ValueRef -> CString -> IO ()

foreign import ccall unsafe "LLVMIsDeclaration" isDeclaration
    :: ValueRef -> IO CInt

-- |An enumeration for the kinds of linkage for global values.
data Linkage
    = ExternalLinkage     -- ^Externally visible function
    | AvailableExternallyLinkage 
    | LinkOnceAnyLinkage  -- ^Keep one copy of function when linking (inline)
    | LinkOnceODRLinkage  -- ^Same, but only replaced by something equivalent.
    | WeakAnyLinkage      -- ^Keep one copy of named function when linking (weak)
    | WeakODRLinkage      -- ^Same, but only replaced by something equivalent.
    | AppendingLinkage    -- ^Special purpose, only applies to global arrays
    | InternalLinkage     -- ^Rename collisions when linking (static functions)
    | PrivateLinkage      -- ^Like Internal, but omit from symbol table
    | DLLImportLinkage    -- ^Function to be imported from DLL
    | DLLExportLinkage    -- ^Function to be accessible from DLL
    | ExternalWeakLinkage -- ^ExternalWeak linkage description
    | GhostLinkage        -- ^Stand-in functions for streaming fns from BC files    
    | CommonLinkage       -- ^Tentative definitions
    | LinkerPrivateLinkage -- ^Like Private, but linker removes.
    deriving (Show, Eq, Ord, Enum, Typeable)

fromLinkage :: Linkage -> CUInt
fromLinkage ExternalLinkage             = (0)
{-# LINE 735 "LLVM/FFI/Core.hsc" #-}
fromLinkage AvailableExternallyLinkage  = (1)
{-# LINE 736 "LLVM/FFI/Core.hsc" #-}
fromLinkage LinkOnceAnyLinkage          = (2)
{-# LINE 737 "LLVM/FFI/Core.hsc" #-}
fromLinkage LinkOnceODRLinkage          = (3)
{-# LINE 738 "LLVM/FFI/Core.hsc" #-}
fromLinkage WeakAnyLinkage              = (4)
{-# LINE 739 "LLVM/FFI/Core.hsc" #-}
fromLinkage WeakODRLinkage              = (5)
{-# LINE 740 "LLVM/FFI/Core.hsc" #-}
fromLinkage AppendingLinkage            = (6)
{-# LINE 741 "LLVM/FFI/Core.hsc" #-}
fromLinkage InternalLinkage             = (7)
{-# LINE 742 "LLVM/FFI/Core.hsc" #-}
fromLinkage PrivateLinkage              = (8)
{-# LINE 743 "LLVM/FFI/Core.hsc" #-}
fromLinkage DLLImportLinkage            = (9)
{-# LINE 744 "LLVM/FFI/Core.hsc" #-}
fromLinkage DLLExportLinkage            = (10)
{-# LINE 745 "LLVM/FFI/Core.hsc" #-}
fromLinkage ExternalWeakLinkage         = (11)
{-# LINE 746 "LLVM/FFI/Core.hsc" #-}
fromLinkage GhostLinkage                = (12)
{-# LINE 747 "LLVM/FFI/Core.hsc" #-}
fromLinkage CommonLinkage               = (13)
{-# LINE 748 "LLVM/FFI/Core.hsc" #-}
fromLinkage LinkerPrivateLinkage        = (14)
{-# LINE 749 "LLVM/FFI/Core.hsc" #-}

toLinkage :: CUInt -> Linkage
toLinkage c | c == (0)             = ExternalLinkage
{-# LINE 752 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (1)  = AvailableExternallyLinkage 
{-# LINE 753 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (2)          = LinkOnceAnyLinkage
{-# LINE 754 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (3)          = LinkOnceODRLinkage
{-# LINE 755 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (4)              = WeakAnyLinkage
{-# LINE 756 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (5)              = WeakODRLinkage
{-# LINE 757 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (6)            = AppendingLinkage
{-# LINE 758 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (7)             = InternalLinkage
{-# LINE 759 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (8)              = PrivateLinkage
{-# LINE 760 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (9)            = DLLImportLinkage
{-# LINE 761 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (10)            = DLLExportLinkage
{-# LINE 762 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (11)         = ExternalWeakLinkage
{-# LINE 763 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (12)                = GhostLinkage
{-# LINE 764 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (13)               = CommonLinkage
{-# LINE 765 "LLVM/FFI/Core.hsc" #-}
toLinkage c | c == (14)        = LinkerPrivateLinkage
{-# LINE 766 "LLVM/FFI/Core.hsc" #-}
toLinkage _ = error "toLinkage: bad value"

foreign import ccall unsafe "LLVMGetLinkage" getLinkage
    :: ValueRef -> IO CUInt

foreign import ccall unsafe "LLVMSetLinkage" setLinkage
    :: ValueRef -> CUInt -> IO ()

foreign import ccall unsafe "LLVMGetSection" getSection
    :: ValueRef -> IO CString

foreign import ccall unsafe "LLVMSetSection" setSection
    :: ValueRef -> CString -> IO ()

-- |An enumeration for the kinds of visibility of global values.
data Visibility
    = DefaultVisibility   -- ^The GV is visible
    | HiddenVisibility    -- ^The GV is hidden
    | ProtectedVisibility -- ^The GV is protected
    deriving (Show, Eq, Ord, Enum)

fromVisibility :: Visibility -> CUInt
fromVisibility DefaultVisibility   = (0)
{-# LINE 789 "LLVM/FFI/Core.hsc" #-}
fromVisibility HiddenVisibility    = (1)
{-# LINE 790 "LLVM/FFI/Core.hsc" #-}
fromVisibility ProtectedVisibility = (2)
{-# LINE 791 "LLVM/FFI/Core.hsc" #-}

toVisibility :: CUInt -> Visibility
toVisibility c | c == (0)   = DefaultVisibility
{-# LINE 794 "LLVM/FFI/Core.hsc" #-}
toVisibility c | c == (1)    = HiddenVisibility
{-# LINE 795 "LLVM/FFI/Core.hsc" #-}
toVisibility c | c == (2) = ProtectedVisibility
{-# LINE 796 "LLVM/FFI/Core.hsc" #-}
toVisibility _ = error "toVisibility: bad value"

foreign import ccall unsafe "LLVMGetVisibility" getVisibility
    :: ValueRef -> IO CUInt

foreign import ccall unsafe "LLVMSetVisibility" setVisibility
    :: ValueRef -> CUInt -> IO ()

foreign import ccall unsafe "LLVMGetAlignment" getAlignment
    :: ValueRef -> IO CUInt

foreign import ccall unsafe "LLVMSetAlignment" setAlignment
    :: ValueRef -> CUInt -> IO ()


foreign import ccall unsafe "LLVMConstInt" constInt
    :: TypeRef -> CULLong -> CInt -> ValueRef

foreign import ccall unsafe "LLVMConstReal" constReal
    :: TypeRef -> CDouble -> ValueRef

foreign import ccall unsafe "LLVMConstString" constString
    :: CString -> CUInt -> CInt -> ValueRef

foreign import ccall unsafe "LLVMConstStruct" constStruct
    :: Ptr ValueRef -> CUInt -> CInt -> ValueRef

foreign import ccall unsafe "LLVMConstVector" constVector
    :: Ptr ValueRef -> CUInt -> ValueRef

foreign import ccall unsafe "LLVMConstNeg" constNeg
    :: ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstNot" constNot
    :: ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstAdd" constAdd
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstSub" constSub
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstMul" constMul
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstUDiv" constUDiv
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstSDiv" constSDiv
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstFDiv" constFDiv
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstURem" constURem
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstSRem" constSRem
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstFRem" constFRem
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstAnd" constAnd
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstOr" constOr
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstXor" constXor
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstICmp" constICmp
    :: CInt -> ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstFCmp" constFCmp
    :: CInt -> ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstShl" constShl
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstLShr" constLShr
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstAShr" constAShr
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstGEP" constGEP
    :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef

foreign import ccall unsafe "LLVMConstTrunc" constTrunc
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstSExt" constSExt
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstZExt" constZExt
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstFPTrunc" constFPTrunc
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstFPExt" constFPExt
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstUIToFP" constUIToFP
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstSIToFP" constSIToFP
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstFPToUI" constFPToUI
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstFPToSI" constFPToSI
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstPtrToInt" constPtrToInt
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstIntToPtr" constIntToPtr
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstBitCast" constBitCast
    :: ValueRef -> TypeRef -> ValueRef

foreign import ccall unsafe "LLVMConstSelect" constSelect
    :: ValueRef -> ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstExtractElement" constExtractElement
    :: ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstInsertElement" constInsertElement
    :: ValueRef -> ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstShuffleVector" constShuffleVector
    :: ValueRef -> ValueRef -> ValueRef -> ValueRef

foreign import ccall unsafe "LLVMConstExtractValue" constExtractValue
    :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef

foreign import ccall unsafe "LLVMConstInsertValue" constInsertValue
    :: ValueRef -> ValueRef -> Ptr ValueRef -> CUInt -> ValueRef

type BasicBlock = Value
type BasicBlockRef = Ptr BasicBlock

foreign import ccall unsafe "LLVMBasicBlockAsValue" basicBlockAsValue
    :: BasicBlockRef -> ValueRef

foreign import ccall unsafe "LLVMValueIsBasicBlock" valueIsBasicBlock
    :: ValueRef -> Bool

foreign import ccall unsafe "LLVMValueAsBasicBlock" valueAsBasicBlock
    :: ValueRef                 -- ^ basic block
    -> BasicBlockRef

foreign import ccall unsafe "LLVMCountBasicBlocks" countBasicBlocks
    :: ValueRef                 -- ^ function
    -> IO CUInt

foreign import ccall unsafe "LLVMGetBasicBlocks" getBasicBlocks
    :: ValueRef                 -- ^ function
    -> Ptr BasicBlockRef        -- ^ array to fill out
    -> IO ()

foreign import ccall unsafe "LLVMGetEntryBasicBlock" getEntryBasicBlock
    :: ValueRef                 -- ^ function
    -> IO BasicBlockRef

foreign import ccall unsafe "LLVMAppendBasicBlock" appendBasicBlock
    :: ValueRef                 -- ^ function
    -> CString                  -- ^ name for label
    -> IO BasicBlockRef

foreign import ccall unsafe "LLVMInsertBasicBlock" insertBasicBlock
    :: BasicBlockRef            -- ^ insert before this one
    -> CString                  -- ^ name for label
    -> IO BasicBlockRef

foreign import ccall unsafe "LLVMDeleteBasicBlock" deleteBasicBlock
    :: BasicBlockRef -> IO ()

data Builder
    deriving (Typeable)
type BuilderRef = Ptr Builder

foreign import ccall unsafe "LLVMCreateBuilder" createBuilder
    :: IO BuilderRef

foreign import ccall unsafe "&LLVMDisposeBuilder" ptrDisposeBuilder
    :: FunPtr (BuilderRef -> IO ())

foreign import ccall unsafe "LLVMPositionBuilderBefore" positionBefore
    :: BuilderRef -> ValueRef -> IO ()

foreign import ccall unsafe "LLVMPositionBuilderAtEnd" positionAtEnd
    :: BuilderRef -> BasicBlockRef -> IO ()

foreign import ccall unsafe "LLVMBuildRetVoid" buildRetVoid
    :: BuilderRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildRet" buildRet
    :: BuilderRef -> ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildBr" buildBr
    :: BuilderRef -> BasicBlockRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildCondBr" buildCondBr
    :: BuilderRef -> ValueRef -> BasicBlockRef -> BasicBlockRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSwitch" buildSwitch
    :: BuilderRef -> ValueRef -> BasicBlockRef -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMBuildInvoke" buildInvoke
    :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt
    -> BasicBlockRef -> BasicBlockRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildUnwind" buildUnwind
    :: BuilderRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildUnreachable" buildUnreachable
    :: BuilderRef -> IO ValueRef

foreign import ccall unsafe "LLVMBuildAdd" buildAdd
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSub" buildSub
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildMul" buildMul
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildUDiv" buildUDiv
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSDiv" buildSDiv
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFDiv" buildFDiv
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildURem" buildURem
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSRem" buildSRem
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFRem" buildFRem
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildShl" buildShl
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildLShr" buildLShr
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildAShr" buildAShr
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildAnd" buildAnd
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildOr" buildOr
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildXor" buildXor
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildNeg" buildNeg
    :: BuilderRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildNot" buildNot
    :: BuilderRef -> ValueRef -> CString -> IO ValueRef

-- Memory
foreign import ccall unsafe "LLVMBuildMalloc" buildMalloc
    :: BuilderRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildArrayMalloc" buildArrayMalloc
    :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildAlloca" buildAlloca
    :: BuilderRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildArrayAlloca" buildArrayAlloca
    :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFree" buildFree
    :: BuilderRef -> ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildLoad" buildLoad
    :: BuilderRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildStore" buildStore
    :: BuilderRef -> ValueRef -> ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMBuildGEP" buildGEP
    :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString
    -> IO ValueRef

-- Casts
foreign import ccall unsafe "LLVMBuildTrunc" buildTrunc
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildZExt" buildZExt
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSExt" buildSExt
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFPToUI" buildFPToUI
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFPToSI" buildFPToSI
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildUIToFP" buildUIToFP
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSIToFP" buildSIToFP
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFPTrunc" buildFPTrunc
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFPExt" buildFPExt
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildPtrToInt" buildPtrToInt
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildIntToPtr" buildIntToPtr
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildBitCast" buildBitCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef

-- Comparisons
foreign import ccall unsafe "LLVMBuildICmp" buildICmp
    :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp
    :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef

-- Miscellaneous instructions
foreign import ccall unsafe "LLVMBuildPhi" buildPhi
    :: BuilderRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildCall" buildCall
    :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSelect" buildSelect
    :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildVAArg" buildVAArg
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildExtractElement" buildExtractElement
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildInsertElement" buildInsertElement
    :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildShuffleVector" buildShuffleVector
    :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildExtractValue" buildExtractValue
    :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildInsertValue" buildInsertValue
    :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef

foreign import ccall unsafe "LLVMAddCase" addCase
    :: ValueRef -> ValueRef -> BasicBlockRef -> IO ()

foreign import ccall unsafe "LLVMCountIncoming" countIncoming
    :: ValueRef -> IO CUInt
foreign import ccall unsafe "LLVMAddIncoming" addIncoming
    :: ValueRef -> Ptr ValueRef -> Ptr ValueRef -> CUInt -> IO ()
foreign import ccall unsafe "LLVMGetIncomingValue" getIncomingValue
    :: ValueRef -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMGetIncomingBlock" getIncomingBlock
    :: ValueRef -> CUInt -> IO BasicBlockRef
       
foreign import ccall unsafe "LLVMGetInstructionCallConv" getInstructionCallConv
    :: ValueRef -> IO CUInt
foreign import ccall unsafe "LLVMSetInstructionCallConv" setInstructionCallConv
    :: ValueRef -> CUInt -> IO ()

foreign import ccall unsafe "LLVMStructType" structType
    :: Ptr TypeRef -> CUInt -> CInt -> TypeRef
foreign import ccall unsafe "LLVMCountStructElementTypes"
    countStructElementTypes :: TypeRef -> CUInt
foreign import ccall unsafe "LLVMGetStructElementTypes" getStructElementTypes
    :: TypeRef -> Ptr TypeRef -> IO ()
foreign import ccall unsafe "LLVMIsPackedStruct" isPackedStruct
    :: TypeRef -> CInt

data MemoryBuffer
    deriving (Typeable)
type MemoryBufferRef = Ptr MemoryBuffer

data TypeHandle
    deriving (Typeable)
type TypeHandleRef = Ptr TypeHandle

data TypeKind
    = VoidTypeKind
    | FloatTypeKind
    | DoubleTypeKind
    | X86_FP80TypeKind
    | FP128TypeKind
    | PPC_FP128TypeKind
    | LabelTypeKind
    | IntegerTypeKind
    | FunctionTypeKind
    | StructTypeKind
    | ArrayTypeKind
    | PointerTypeKind
    | OpaqueTypeKind
    | VectorTypeKind
    deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable)

getTypeKind :: TypeRef -> IO TypeKind
getTypeKind = fmap (toEnum . fromIntegral) . getTypeKindCUInt

foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile
    :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO CInt
foreign import ccall unsafe "LLVMCreateMemoryBufferWithSTDIN" createMemoryBufferWithSTDIN
    :: Ptr MemoryBufferRef -> Ptr CString -> IO CInt
foreign import ccall unsafe "LLVMCreateTypeHandle" createTypeHandle
    :: TypeRef -> IO TypeHandleRef
foreign import ccall unsafe "LLVMDisposeMemoryBuffer" disposeMemoryBuffer
    :: MemoryBufferRef -> IO ()
foreign import ccall unsafe "LLVMDisposeMessage" disposeMessage
    :: CString -> IO ()
foreign import ccall unsafe "LLVMDisposeTypeHandle" disposeTypeHandle
    :: TypeHandleRef -> IO ()
foreign import ccall unsafe "LLVMGetArrayLength" getArrayLength
    :: TypeRef -> IO CUInt
foreign import ccall unsafe "LLVMGetIntTypeWidth" getIntTypeWidth
    :: TypeRef -> IO CUInt
foreign import ccall unsafe "LLVMGetPointerAddressSpace" getPointerAddressSpace
    :: TypeRef -> IO CUInt
foreign import ccall unsafe "LLVMGetTarget" getTarget
    :: ModuleRef -> IO CString
foreign import ccall unsafe "LLVMGetTypeKind" getTypeKindCUInt
    :: TypeRef -> IO CUInt
foreign import ccall unsafe "LLVMGetVectorSize" getVectorSize
    :: TypeRef -> IO CUInt
foreign import ccall unsafe "LLVMRefineType" refineType
    :: TypeRef -> TypeRef -> IO ()
foreign import ccall unsafe "LLVMResolveTypeHandle" resolveTypeHandle
    :: TypeHandleRef -> IO TypeRef
foreign import ccall unsafe "LLVMSetTarget" setTarget
    :: ModuleRef -> CString -> IO ()
foreign import ccall unsafe "LLVMSizeOf" sizeOf
    :: TypeRef -> IO ValueRef

data Attribute
    = ZExtAttribute
    | SExtAttribute
    | NoReturnAttribute
    | InRegAttribute
    | StructRetAttribute
    | NoUnwindAttribute
    | NoAliasAttribute
    | ByValAttribute
    | NestAttribute
    | ReadNoneAttribute
    | ReadOnlyAttribute
    deriving (Show, Eq, Ord, Enum, Bounded, Typeable)

fromAttribute :: Attribute -> CAttribute
fromAttribute ZExtAttribute = (1)
{-# LINE 1222 "LLVM/FFI/Core.hsc" #-}
fromAttribute SExtAttribute = (2)
{-# LINE 1223 "LLVM/FFI/Core.hsc" #-}
fromAttribute NoReturnAttribute = (4)
{-# LINE 1224 "LLVM/FFI/Core.hsc" #-}
fromAttribute InRegAttribute = (8)
{-# LINE 1225 "LLVM/FFI/Core.hsc" #-}
fromAttribute StructRetAttribute = (16)
{-# LINE 1226 "LLVM/FFI/Core.hsc" #-}
fromAttribute NoUnwindAttribute = (32)
{-# LINE 1227 "LLVM/FFI/Core.hsc" #-}
fromAttribute NoAliasAttribute = (64)
{-# LINE 1228 "LLVM/FFI/Core.hsc" #-}
fromAttribute ByValAttribute = (128)
{-# LINE 1229 "LLVM/FFI/Core.hsc" #-}
fromAttribute NestAttribute = (256)
{-# LINE 1230 "LLVM/FFI/Core.hsc" #-}
fromAttribute ReadNoneAttribute = (512)
{-# LINE 1231 "LLVM/FFI/Core.hsc" #-}
fromAttribute ReadOnlyAttribute = (1024)
{-# LINE 1232 "LLVM/FFI/Core.hsc" #-}

toAttribute :: CAttribute -> Attribute
toAttribute c | c == (1) = ZExtAttribute
{-# LINE 1235 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (2) = SExtAttribute
{-# LINE 1236 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (4) = NoReturnAttribute
{-# LINE 1237 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (8) = InRegAttribute
{-# LINE 1238 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (16) = StructRetAttribute
{-# LINE 1239 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (32) = NoUnwindAttribute
{-# LINE 1240 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (64) = NoAliasAttribute
{-# LINE 1241 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (128) = ByValAttribute
{-# LINE 1242 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (256) = NestAttribute
{-# LINE 1243 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (512) = ReadNoneAttribute
{-# LINE 1244 "LLVM/FFI/Core.hsc" #-}
toAttribute c | c == (1024) = ReadOnlyAttribute
{-# LINE 1245 "LLVM/FFI/Core.hsc" #-}
toAttribute _ = error "toAttribute: bad value"

type CAttribute = CInt

data PassManager
    deriving (Typeable)
type PassManagerRef = Ptr PassManager

foreign import ccall unsafe "LLVMConstRealOfString" constRealOfString
    :: TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMCreateFunctionPassManager" createFunctionPassManager
    :: ModuleProviderRef -> IO PassManagerRef
foreign import ccall unsafe "LLVMCreatePassManager" createPassManager
    :: IO PassManagerRef
foreign import ccall unsafe "&LLVMDisposePassManager" ptrDisposePassManager
    :: FunPtr (PassManagerRef -> IO ())
foreign import ccall unsafe "LLVMDumpModule" dumpModule
    :: ModuleRef -> IO ()
foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager
    :: PassManagerRef -> IO CInt
foreign import ccall unsafe "LLVMGetBasicBlockParent" getBasicBlockParent
    :: BasicBlockRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock
    :: ValueRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetFirstFunction" getFirstFunction
    :: ModuleRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetFirstGlobal" getFirstGlobal
    :: ModuleRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetFirstInstruction" getFirstInstruction
    :: BasicBlockRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetFirstParam" getFirstParam
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetGlobalParent" getGlobalParent
    :: ValueRef -> IO ModuleRef
foreign import ccall unsafe "LLVMGetInsertBlock" getInsertBlock
    :: BuilderRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetInstructionParent" getInstructionParent
    :: ValueRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetLastBasicBlock" getLastBasicBlock
    :: ValueRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetLastFunction" getLastFunction
    :: ModuleRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetLastGlobal" getLastGlobal
    :: ModuleRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetLastInstruction" getLastInstruction
    :: BasicBlockRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetLastParam" getLastParam
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetNextBasicBlock" getNextBasicBlock
    :: BasicBlockRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetNextFunction" getNextFunction
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetNextGlobal" getNextGlobal
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetNextInstruction" getNextInstruction
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetNextParam" getNextParam
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetParamParent" getParamParent
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetPreviousBasicBlock" getPreviousBasicBlock
    :: BasicBlockRef -> IO BasicBlockRef
foreign import ccall unsafe "LLVMGetPreviousFunction" getPreviousFunction
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetPreviousGlobal" getPreviousGlobal
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetPreviousInstruction" getPreviousInstruction
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMGetPreviousParam" getPreviousParam
    :: ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager
    :: PassManagerRef -> IO CInt
foreign import ccall unsafe "LLVMLabelType" labelType
    :: TypeRef
foreign import ccall unsafe "LLVMOpaqueType" opaqueType
    :: TypeRef
foreign import ccall unsafe "LLVMPositionBuilder" positionBuilder
    :: BuilderRef -> BasicBlockRef -> ValueRef -> IO ()
foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager
    :: PassManagerRef -> ValueRef -> IO CInt
foreign import ccall unsafe "LLVMRunPassManager" runPassManager
    :: PassManagerRef -> ModuleRef -> IO CInt
foreign import ccall unsafe "LLVMSetInstrParamAlignment" setInstrParamAlignment
    :: ValueRef -> CUInt -> CUInt -> IO ()
foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment
    :: ValueRef -> CUInt -> IO ()


data Context
    deriving (Typeable)
type ContextRef = Ptr Context

foreign import ccall unsafe "LLVMAddAttribute" addAttribute
    :: ValueRef -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute
    :: ValueRef -> CUInt -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMIsTailCall" isTailCall
    :: ValueRef -> IO CInt
foreign import ccall unsafe "LLVMRemoveAttribute" removeAttribute
    :: ValueRef -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMRemoveInstrAttribute" removeInstrAttribute
    :: ValueRef -> CUInt -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMSetTailCall" setTailCall
    :: ValueRef -> CInt -> IO ()
foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr
    :: ValueRef -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMAlignOf" alignOf
    :: TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMAppendBasicBlockInContext" appendBasicBlockInContext
    :: ContextRef -> ValueRef -> CString -> IO BasicBlockRef
foreign import ccall unsafe "LLVMBuildAggregateRet" buildAggregateRet
    :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMBuildExactSDiv" buildExactSDiv
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFAdd" buildFAdd
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFMul" buildFMul
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFPCast" buildFPCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildFSub" buildFSub
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildGlobalString" buildGlobalString
    :: BuilderRef -> CString -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildGlobalStringPtr" buildGlobalStringPtr
    :: BuilderRef -> CString -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGEP
    :: BuilderRef -> ValueRef -> (Ptr ValueRef) -> CUInt -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildIntCast" buildIntCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildIsNotNull" buildIsNotNull
    :: BuilderRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildIsNull" buildIsNull
    :: BuilderRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildNSWAdd" buildNSWAdd
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildPointerCast" buildPointerCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildPtrDiff" buildPtrDiff
    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildSExtOrBitCast" buildSExtOrBitCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildStructGEP" buildStructGEP
    :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildTruncOrBitCast" buildTruncOrBitCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMBuildZExtOrBitCast" buildZExtOrBitCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
foreign import ccall unsafe "LLVMConstExactSDiv" constExactSDiv
    :: ValueRef -> ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstFAdd" constFAdd
    :: ValueRef -> ValueRef -> ValueRef
foreign import ccall unsafe "LLVMConstFMul" constFMul
    :: ValueRef -> ValueRef -> ValueRef
foreign import ccall unsafe "LLVMConstFNeg" constFNeg
    :: ValueRef -> ValueRef
foreign import ccall unsafe "LLVMConstFPCast" constFPCast
    :: ValueRef -> TypeRef -> ValueRef
foreign import ccall unsafe "LLVMConstFSub" constFSub
    :: ValueRef -> ValueRef -> ValueRef
foreign import ccall unsafe "LLVMConstInBoundsGEP" constInBoundsGEP
    :: ValueRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstIntCast" constIntCast
    :: ValueRef -> TypeRef -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstIntOfString" constIntOfString
    :: TypeRef -> CString -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstIntOfStringAndSize" constIntOfStringAndSize
    :: TypeRef -> CString -> CUInt -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstNSWAdd" constNSWAdd
    :: ValueRef -> ValueRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstPointerCast" constPointerCast
    :: ValueRef -> TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstPointerNull" constPointerNull
    :: TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstRealOfStringAndSize" constRealOfStringAndSize
    :: TypeRef -> CString -> CUInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstSExtOrBitCast" constSExtOrBitCast
    :: ValueRef -> TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstStringInContext" constStringInContext
    :: ContextRef -> CString -> CUInt -> CInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstStructInContext" constStructInContext
    :: ContextRef -> (Ptr ValueRef) -> CUInt -> CInt -> IO ValueRef
foreign import ccall unsafe "LLVMConstTruncOrBitCast" constTruncOrBitCast
    :: ValueRef -> TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMConstZExtOrBitCast" constZExtOrBitCast
    :: ValueRef -> TypeRef -> IO ValueRef
foreign import ccall unsafe "LLVMContextDispose" contextDispose
    :: ContextRef -> IO ()
foreign import ccall unsafe "LLVMCreateBuilderInContext" createBuilderInContext
    :: ContextRef -> IO BuilderRef
foreign import ccall unsafe "LLVMDoubleTypeInContext" doubleTypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMFP128TypeInContext" fP128TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMFloatTypeInContext" floatTypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMGetTypeByName" getTypeByName
    :: ModuleRef -> CString -> IO TypeRef
foreign import ccall unsafe "LLVMGetTypeContext" getTypeContext
    :: TypeRef -> IO ContextRef
foreign import ccall unsafe "LLVMInsertBasicBlockInContext" insertBasicBlockInContext
    :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef
foreign import ccall unsafe "LLVMInsertIntoBuilderWithName" insertIntoBuilderWithName
    :: BuilderRef -> ValueRef -> CString -> IO ()
foreign import ccall unsafe "LLVMInt16TypeInContext" int16TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMInt1TypeInContext" int1TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMInt32TypeInContext" int32TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMInt64TypeInContext" int64TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMInt8TypeInContext" int8TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMIntTypeInContext" intTypeInContext
    :: ContextRef -> CUInt -> IO TypeRef
foreign import ccall unsafe "LLVMLabelTypeInContext" labelTypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMModuleCreateWithNameInContext" moduleCreateWithNameInContext
    :: CString -> ContextRef -> IO ModuleRef
foreign import ccall unsafe "LLVMOpaqueTypeInContext" opaqueTypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMPPCFP128TypeInContext" pPCFP128TypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMRemoveFunctionAttr" removeFunctionAttr
    :: ValueRef -> CAttribute -> IO ()
foreign import ccall unsafe "LLVMStructTypeInContext" structTypeInContext
    :: ContextRef -> (Ptr TypeRef) -> CUInt -> CInt -> IO TypeRef
foreign import ccall unsafe "LLVMVoidTypeInContext" voidTypeInContext
    :: ContextRef -> IO TypeRef
foreign import ccall unsafe "LLVMX86FP80TypeInContext" x86FP80TypeInContext
    :: ContextRef -> IO TypeRef