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

-- |
-- Raw.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
    (
      Version.version

    -- * Boolean values
    , LLVM.Bool(LLVM.Bool)
    , LLVM.false
    , LLVM.true
    , LLVM.consBool
    , LLVM.deconsBool

    -- * Error handling
    , disposeMessage

    -- * Raw.Context functions
    , Raw.Context
    , ContextRef
    , contextCreate
    , contextDispose
    , getGlobalContext

    , getMDKindID
    , getMDKindIDInContext

      -- * Modules
    , Raw.Module
    , ModuleRef
    , moduleCreateWithName
    , moduleCreateWithNameInContext
    , disposeModule
    , ptrDisposeModule

    , getDataLayout
    , setDataLayout

    , getTarget
    , setTarget

    , defaultTargetTriple
    , hostTriple

    , dumpModule

    , setModuleInlineAsm
    , getModuleContext

    -- * Types
    , Raw.Type
    , TypeRef
    , TypeKind(..)

    , getTypeKind
    , typeIsSized
    , getTypeContext

    -- ** Integer types
    , int1TypeInContext
    , int8TypeInContext
    , int16TypeInContext
    , int32TypeInContext
    , int64TypeInContext
    , intTypeInContext

    , int1Type
    , int8Type
    , int16Type
    , int32Type
    , int64Type
    , integerType
    , getIntTypeWidth

    -- ** Real types
    , floatTypeInContext
    , doubleTypeInContext
    , x86FP80TypeInContext
    , fp128TypeInContext
    , ppcFP128TypeInContext

    , floatType
    , doubleType
    , x86FP80Type
    , fp128Type
    , ppcFP128Type

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

    -- ** Struct types
    , structTypeInContext
    , structType
    , structCreateNamed
    , getStructName
    , structSetBody

    , countStructElementTypes
    , getStructElementTypes
    , isPackedStruct
    , isOpaqueStruct

    , getTypeByName

    -- ** Array, pointer, and vector types
    , arrayType
    , pointerType
    , vectorType

    , getElementType
    , getArrayLength
    , getPointerAddressSpace
    , getVectorSize

    -- ** Other types
    , voidTypeInContext
    , labelTypeInContext

    , voidType
    , labelType

    -- * Values
    , Raw.Value
    , ValueRef
    , typeOf
    , getValueName
    , setValueName
    , dumpValue
    , replaceAllUsesWith
    , hasMetadata
    , getMetadata
    , setMetadata

    -- ** Uses
    , Raw.OpaqueUse
    , UseRef
    , getFirstUse
    , getNextUse
    , getUser
    , getUsedValue

    -- ** Users
    , getOperand
    , setOperand
    , getNumOperands

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

    -- ** Metadata
    , mDStringInContext
    , mDString
    , mDNodeInContext
    , mDNode
    , getMDString
    , getNamedMetadataNumOperands
    , getNamedMetadataOperands

    -- ** Scalar constants
    , constInt
    , constIntOfArbitraryPrecision
    , constIntOfString
    , constIntOfStringAndSize
    , constReal
    , constRealOfString
    , constRealOfStringAndSize
    , constIntGetZExtValue
    , constIntGetSExtValue

    -- ** Composite constants
    , constStringInContext
    , constStructInContext
    , constString
    , constArray
    , constStruct
    , constNamedStruct
    , constVector

    -- ** Constant Expressions
    , getConstOpcode
    , alignOf
    , sizeOf
    , constNeg
    , constNSWNeg
    , constNot
    , constAdd
    , constNSWAdd
    , constNUWAdd
    , constSub
    , constNSWSub
    , constNUWSub
    , constMul
    , constNSWMul
    , constNUWMul
    , constXor
    , constGEP2
    , constInBoundsGEP2
    , constTrunc
    , constPtrToInt
    , constIntToPtr
    , constBitCast
    , constTruncOrBitCast
    , constPointerCast
    , constExtractElement
    , constInsertElement
    , constShuffleVector
    , constInlineAsm
    , blockAddress

    -- ** Comparison predicates
    , IntPredicate(..)
    , fromIntPredicate
    , toIntPredicate
    , FPPredicate(..)
    , fromRealPredicate
    , toRealPredicate

    -- ** Floating point attributes
    , setFastMath
    , setHasUnsafeAlgebra
    , setHasNoNaNs
    , setHasNoInfs
    , setHasNoSignedZeros
    , setHasAllowReciprocal
    , setHasAllowReassoc
    , setHasApproxFunc

    -- ** Support operations and types
    , Linkage(..)
    , fromLinkage
    , toLinkage

    , Visibility(..)
    , fromVisibility
    , toVisibility

    -- ** Global variables, functions, and aliases (globals)
    , getGlobalParent
    , isDeclaration
    , getLinkage
    , setLinkage
    , getSection
    , setSection
    , getVisibility
    , setVisibility
    , getAlignment
    , setAlignment

    -- ** Global variables
    , addGlobal
    , addGlobalInAddressSpace
    , getNamedGlobal
    , getFirstGlobal
    , getLastGlobal
    , getNextGlobal
    , getPreviousGlobal
    , deleteGlobal
    , getInitializer
    , setInitializer
    , isThreadLocal
    , setThreadLocal
    , isGlobalConstant
    , setGlobalConstant

    -- ** Aliases
    , addAlias2

    -- * Parameter passing
    , Raw.Attribute
    , AttributeRef
    , AttributeKind(..)

    -- ** Calling conventions
    , CallingConvention(..)
    , fromCallingConvention
    , toCallingConvention

    -- ** Functions
    , addFunction
    , getNamedFunction
    , getFirstFunction
    , getLastFunction
    , getNextFunction
    , getPreviousFunction
    , deleteFunction
    , getIntrinsicID
    , getFunctionCallConv
    , setFunctionCallConv
    , getGC
    , setGC
    , AttributeIndex(AttributeIndex)
    , Raw.attributeReturnIndex, Raw.attributeFunctionIndex
    , getEnumAttributeKindForName
    , getLastEnumAttributeKind
    , createEnumAttribute
    , getEnumAttributeKind
    , getEnumAttributeValue
    , createStringAttribute
    , getStringAttributeKind
    , getStringAttributeValue
    , isEnumAttribute
    , isStringAttribute
    , addAttributeAtIndex
    , getAttributeCountAtIndex
    , getAttributesAtIndex
    , getEnumAttributeAtIndex
    , getStringAttributeAtIndex
    , removeEnumAttributeAtIndex
    , removeStringAttributeAtIndex
    , addTargetDependentFunctionAttr
    , addCallSiteAttribute
    , getCallSiteAttributeCount
    , getCallSiteAttributes
    , getCallSiteEnumAttribute
    , getCallSiteStringAttribute
    , removeCallSiteEnumAttribute
    , removeCallSiteStringAttribute
    , getCalledValue

    -- ** Parameters
    , countParams
    , getParams
    , getParam
    , getParamParent
    , getFirstParam
    , getLastParam
    , getNextParam
    , getPreviousParam
    , setParamAlignment

    -- ** Basic blocks
    , Raw.BasicBlock
    , BasicBlockRef
    , basicBlockAsValue
    , valueIsBasicBlock
    , valueAsBasicBlock
    , getBasicBlockName
    , getBasicBlockParent
    , getBasicBlockTerminator
    , countBasicBlocks
    , getBasicBlocks
    , getFirstBasicBlock
    , getLastBasicBlock
    , getNextBasicBlock
    , getPreviousBasicBlock
    , getEntryBasicBlock
    , appendBasicBlockInContext
    , insertBasicBlockInContext
    , appendBasicBlock
    , insertBasicBlock
    , deleteBasicBlock
    , removeBasicBlockFromParent
    , moveBasicBlockBefore
    , moveBasicBlockAfter
    , getFirstInstruction
    , getLastInstruction

    -- ** Instructions
    , getInstructionParent
    , getNextInstruction
    , getPreviousInstruction
    , instructionEraseFromParent
    , getInstructionOpcode
    , getICmpPredicate

    -- ** Call Sites
    , getInstructionCallConv
    , setInstructionCallConv
    , setInstrParamAlignment

    -- ** Call Instructions (only)
    , isTailCall
    , setTailCall

    -- ** Switch Instructions (only)
    , getSwitchDefaultDest

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

    -- * Instruction building
    , Raw.Builder
    , BuilderRef
    , createBuilderInContext
    , createBuilder
    , positionBuilder
    , positionBefore
    , positionAtEnd
    , getInsertBlock
    , clearInsertionPosition
    , insertIntoBuilder
    , insertIntoBuilderWithName
    , ptrDisposeBuilder

    -- ** Metadata
    , setCurrentDebugLocation
    , getCurrentDebugLocation
    , setInstDebugLocation

    -- ** Terminators
    , buildRetVoid
    , buildRet
    , buildAggregateRet
    , buildBr
    , buildCondBr
    , buildSwitch
    , buildIndirectBr
    , buildInvoke2
    , buildLandingPad
    , buildResume
    , buildUnreachable

    , addCase
    , addDestination
    , addClause
    , setCleanup

    -- ** Arithmetic
    , buildAdd
    , buildNSWAdd
    , buildNUWAdd
    , buildFAdd
    , buildSub
    , buildNSWSub
    , buildNUWSub
    , buildFSub
    , buildMul
    , buildNSWMul
    , buildNUWMul
    , buildFMul
    , buildUDiv
    , buildSDiv
    , buildExactSDiv
    , buildFDiv
    , buildURem
    , buildSRem
    , buildFRem
    , buildShl
    , buildLShr
    , buildAShr
    , buildAnd
    , buildOr
    , buildXor
    , buildBinOp
    , buildNeg
    , buildNSWNeg
    , buildFNeg
    , buildNot

    -- ** Memory
    , buildMalloc
    , buildArrayMalloc
    , buildAlloca
    , buildArrayAlloca
    , buildFree
    , buildLoad2
    , buildStore
    , buildGEP2
    , buildInBoundsGEP2
    , buildStructGEP2
    , buildGlobalString
    , buildGlobalStringPtr

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

    -- ** Comparisons
    , buildICmp
    , buildFCmp

    -- ** Miscellaneous instructions
    , buildPhi
    , buildCall2
    , buildSelect
    , buildVAArg
    , buildExtractElement
    , buildInsertElement
    , buildShuffleVector
    , buildExtractValue
    , buildInsertValue
    , buildIsNull
    , buildIsNotNull
    , buildPtrDiff2

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

    -- ** Raw.PassRegistry
    , Raw.PassRegistry
    , PassRegistryRef

    -- ** Pass manager
    , Raw.PassManager
    , PassManagerRef
    , ptrDisposePassManager

    , createPassManager
    , createFunctionPassManagerForModule
    , runPassManager
    , initializeFunctionPassManager
    , runFunctionPassManager
    , finalizeFunctionPassManager
    , disposePassManager

    -- ** Functions from extras.cpp
    , getNumUses
    , instGetOpcode
    , cmpInstGetIntPredicate
    , cmpInstGetRealPredicate

    ) where

import qualified LLVM.FFI.Version as Version
import qualified LLVM.FFI.Base as LLVM
import qualified LLVM.FFI.Core14 as Core14
import qualified LLVM.Raw.Core as Raw
import LLVM.Raw.Core (
         PassRegistryRef, ContextRef, AttributeRef, AttributeIndex,
         ModuleRef, TypeRef,
         BasicBlockRef, ValueRef, UseRef, BuilderRef,
         MemoryBufferRef, PassManagerRef, PassRegistryRef, ContextRef)

import qualified Foreign.C.Types as C
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)

import Data.Typeable (Typeable)

import Data.Word (Word8, Word64)

import Prelude
         (IO, Eq, Ord, Bounded, Enum, Show, Read, String,
          ($), (++), (.), error,
           fmap, fromIntegral, show, toEnum, )


type CDouble  = C.CDouble
type CInt     = C.CInt
type CUInt    = C.CUInt
type CLLong   = C.CLLong
type CULLong  = C.CULLong

type FunctionRef = ValueRef






defaultTargetTriple, hostTriple :: String
defaultTargetTriple :: String
defaultTargetTriple = (String
"x86_64-pc-linux-gnu")
{-# LINE 600 "src/LLVM/FFI/Core.hsc" #-}
hostTriple          = ("x86_64-pc-linux-gnu")
{-# LINE 601 "src/LLVM/FFI/Core.hsc" #-}


data TypeKind
    = VoidTypeKind
    | FloatTypeKind
    | DoubleTypeKind
    | X86_FP80TypeKind
    | FP128TypeKind
    | PPC_FP128TypeKind
    | LabelTypeKind
    | IntegerTypeKind
    | FunctionTypeKind
    | StructTypeKind
    | ArrayTypeKind
    | PointerTypeKind
    | OpaqueTypeKind
    | VectorTypeKind
    deriving (TypeKind -> TypeKind -> Bool
(TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool) -> Eq TypeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeKind -> TypeKind -> Bool
== :: TypeKind -> TypeKind -> Bool
$c/= :: TypeKind -> TypeKind -> Bool
/= :: TypeKind -> TypeKind -> Bool
Eq, Eq TypeKind
Eq TypeKind
-> (TypeKind -> TypeKind -> Ordering)
-> (TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> TypeKind)
-> (TypeKind -> TypeKind -> TypeKind)
-> Ord TypeKind
TypeKind -> TypeKind -> Bool
TypeKind -> TypeKind -> Ordering
TypeKind -> TypeKind -> TypeKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeKind -> TypeKind -> Ordering
compare :: TypeKind -> TypeKind -> Ordering
$c< :: TypeKind -> TypeKind -> Bool
< :: TypeKind -> TypeKind -> Bool
$c<= :: TypeKind -> TypeKind -> Bool
<= :: TypeKind -> TypeKind -> Bool
$c> :: TypeKind -> TypeKind -> Bool
> :: TypeKind -> TypeKind -> Bool
$c>= :: TypeKind -> TypeKind -> Bool
>= :: TypeKind -> TypeKind -> Bool
$cmax :: TypeKind -> TypeKind -> TypeKind
max :: TypeKind -> TypeKind -> TypeKind
$cmin :: TypeKind -> TypeKind -> TypeKind
min :: TypeKind -> TypeKind -> TypeKind
Ord, Int -> TypeKind
TypeKind -> Int
TypeKind -> [TypeKind]
TypeKind -> TypeKind
TypeKind -> TypeKind -> [TypeKind]
TypeKind -> TypeKind -> TypeKind -> [TypeKind]
(TypeKind -> TypeKind)
-> (TypeKind -> TypeKind)
-> (Int -> TypeKind)
-> (TypeKind -> Int)
-> (TypeKind -> [TypeKind])
-> (TypeKind -> TypeKind -> [TypeKind])
-> (TypeKind -> TypeKind -> [TypeKind])
-> (TypeKind -> TypeKind -> TypeKind -> [TypeKind])
-> Enum TypeKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TypeKind -> TypeKind
succ :: TypeKind -> TypeKind
$cpred :: TypeKind -> TypeKind
pred :: TypeKind -> TypeKind
$ctoEnum :: Int -> TypeKind
toEnum :: Int -> TypeKind
$cfromEnum :: TypeKind -> Int
fromEnum :: TypeKind -> Int
$cenumFrom :: TypeKind -> [TypeKind]
enumFrom :: TypeKind -> [TypeKind]
$cenumFromThen :: TypeKind -> TypeKind -> [TypeKind]
enumFromThen :: TypeKind -> TypeKind -> [TypeKind]
$cenumFromTo :: TypeKind -> TypeKind -> [TypeKind]
enumFromTo :: TypeKind -> TypeKind -> [TypeKind]
$cenumFromThenTo :: TypeKind -> TypeKind -> TypeKind -> [TypeKind]
enumFromThenTo :: TypeKind -> TypeKind -> TypeKind -> [TypeKind]
Enum, TypeKind
TypeKind -> TypeKind -> Bounded TypeKind
forall a. a -> a -> Bounded a
$cminBound :: TypeKind
minBound :: TypeKind
$cmaxBound :: TypeKind
maxBound :: TypeKind
Bounded, Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
(Int -> TypeKind -> ShowS)
-> (TypeKind -> String) -> ([TypeKind] -> ShowS) -> Show TypeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeKind -> ShowS
showsPrec :: Int -> TypeKind -> ShowS
$cshow :: TypeKind -> String
show :: TypeKind -> String
$cshowList :: [TypeKind] -> ShowS
showList :: [TypeKind] -> ShowS
Show, ReadPrec [TypeKind]
ReadPrec TypeKind
Int -> ReadS TypeKind
ReadS [TypeKind]
(Int -> ReadS TypeKind)
-> ReadS [TypeKind]
-> ReadPrec TypeKind
-> ReadPrec [TypeKind]
-> Read TypeKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TypeKind
readsPrec :: Int -> ReadS TypeKind
$creadList :: ReadS [TypeKind]
readList :: ReadS [TypeKind]
$creadPrec :: ReadPrec TypeKind
readPrec :: ReadPrec TypeKind
$creadListPrec :: ReadPrec [TypeKind]
readListPrec :: ReadPrec [TypeKind]
Read, Typeable)

getTypeKind :: TypeRef -> IO TypeKind
getTypeKind :: TypeRef -> IO TypeKind
getTypeKind = (TypeKind -> TypeKind) -> IO TypeKind -> IO TypeKind
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> TypeKind
forall a. Enum a => Int -> a
toEnum (Int -> TypeKind) -> (TypeKind -> Int) -> TypeKind -> TypeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (TypeKind -> Word32) -> TypeKind -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind -> Word32
Raw.unTypeKind) (IO TypeKind -> IO TypeKind)
-> (TypeRef -> IO TypeKind) -> TypeRef -> IO TypeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> IO TypeKind
getTypeKindRaw

data CallingConvention = C
                       | Fast
                       | Cold
                       | X86StdCall
                       | X86FastCall
                       | GHC
                         deriving (Int -> CallingConvention -> ShowS
[CallingConvention] -> ShowS
CallingConvention -> String
(Int -> CallingConvention -> ShowS)
-> (CallingConvention -> String)
-> ([CallingConvention] -> ShowS)
-> Show CallingConvention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CallingConvention -> ShowS
showsPrec :: Int -> CallingConvention -> ShowS
$cshow :: CallingConvention -> String
show :: CallingConvention -> String
$cshowList :: [CallingConvention] -> ShowS
showList :: [CallingConvention] -> ShowS
Show, CallingConvention -> CallingConvention -> Bool
(CallingConvention -> CallingConvention -> Bool)
-> (CallingConvention -> CallingConvention -> Bool)
-> Eq CallingConvention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CallingConvention -> CallingConvention -> Bool
== :: CallingConvention -> CallingConvention -> Bool
$c/= :: CallingConvention -> CallingConvention -> Bool
/= :: CallingConvention -> CallingConvention -> Bool
Eq, Eq CallingConvention
Eq CallingConvention
-> (CallingConvention -> CallingConvention -> Ordering)
-> (CallingConvention -> CallingConvention -> Bool)
-> (CallingConvention -> CallingConvention -> Bool)
-> (CallingConvention -> CallingConvention -> Bool)
-> (CallingConvention -> CallingConvention -> Bool)
-> (CallingConvention -> CallingConvention -> CallingConvention)
-> (CallingConvention -> CallingConvention -> CallingConvention)
-> Ord CallingConvention
CallingConvention -> CallingConvention -> Bool
CallingConvention -> CallingConvention -> Ordering
CallingConvention -> CallingConvention -> CallingConvention
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CallingConvention -> CallingConvention -> Ordering
compare :: CallingConvention -> CallingConvention -> Ordering
$c< :: CallingConvention -> CallingConvention -> Bool
< :: CallingConvention -> CallingConvention -> Bool
$c<= :: CallingConvention -> CallingConvention -> Bool
<= :: CallingConvention -> CallingConvention -> Bool
$c> :: CallingConvention -> CallingConvention -> Bool
> :: CallingConvention -> CallingConvention -> Bool
$c>= :: CallingConvention -> CallingConvention -> Bool
>= :: CallingConvention -> CallingConvention -> Bool
$cmax :: CallingConvention -> CallingConvention -> CallingConvention
max :: CallingConvention -> CallingConvention -> CallingConvention
$cmin :: CallingConvention -> CallingConvention -> CallingConvention
min :: CallingConvention -> CallingConvention -> CallingConvention
Ord, Int -> CallingConvention
CallingConvention -> Int
CallingConvention -> [CallingConvention]
CallingConvention -> CallingConvention
CallingConvention -> CallingConvention -> [CallingConvention]
CallingConvention
-> CallingConvention -> CallingConvention -> [CallingConvention]
(CallingConvention -> CallingConvention)
-> (CallingConvention -> CallingConvention)
-> (Int -> CallingConvention)
-> (CallingConvention -> Int)
-> (CallingConvention -> [CallingConvention])
-> (CallingConvention -> CallingConvention -> [CallingConvention])
-> (CallingConvention -> CallingConvention -> [CallingConvention])
-> (CallingConvention
    -> CallingConvention -> CallingConvention -> [CallingConvention])
-> Enum CallingConvention
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CallingConvention -> CallingConvention
succ :: CallingConvention -> CallingConvention
$cpred :: CallingConvention -> CallingConvention
pred :: CallingConvention -> CallingConvention
$ctoEnum :: Int -> CallingConvention
toEnum :: Int -> CallingConvention
$cfromEnum :: CallingConvention -> Int
fromEnum :: CallingConvention -> Int
$cenumFrom :: CallingConvention -> [CallingConvention]
enumFrom :: CallingConvention -> [CallingConvention]
$cenumFromThen :: CallingConvention -> CallingConvention -> [CallingConvention]
enumFromThen :: CallingConvention -> CallingConvention -> [CallingConvention]
$cenumFromTo :: CallingConvention -> CallingConvention -> [CallingConvention]
enumFromTo :: CallingConvention -> CallingConvention -> [CallingConvention]
$cenumFromThenTo :: CallingConvention
-> CallingConvention -> CallingConvention -> [CallingConvention]
enumFromThenTo :: CallingConvention
-> CallingConvention -> CallingConvention -> [CallingConvention]
Enum, CallingConvention
CallingConvention -> CallingConvention -> Bounded CallingConvention
forall a. a -> a -> Bounded a
$cminBound :: CallingConvention
minBound :: CallingConvention
$cmaxBound :: CallingConvention
maxBound :: CallingConvention
Bounded, Typeable)

fromCallingConvention :: CallingConvention -> Raw.CallingConvention
fromCallingConvention :: CallingConvention -> CallingConvention
fromCallingConvention CallingConvention
c =
    CUInt -> CallingConvention
Raw.CallingConvention (CUInt -> CallingConvention) -> CUInt -> CallingConvention
forall a b. (a -> b) -> a -> b
$
    case CallingConvention
c of
        CallingConvention
C -> (CUInt
0)
{-# LINE 636 "src/LLVM/FFI/Core.hsc" #-}
        CallingConvention
Fast -> (CUInt
8)
{-# LINE 637 "src/LLVM/FFI/Core.hsc" #-}
        CallingConvention
Cold -> (CUInt
9)
{-# LINE 638 "src/LLVM/FFI/Core.hsc" #-}
        CallingConvention
X86StdCall -> (CUInt
65)
{-# LINE 639 "src/LLVM/FFI/Core.hsc" #-}
        CallingConvention
X86FastCall -> (CUInt
64)
{-# LINE 640 "src/LLVM/FFI/Core.hsc" #-}
        CallingConvention
GHC -> CUInt
10

toCallingConvention :: Raw.CallingConvention -> CallingConvention
toCallingConvention :: CallingConvention -> CallingConvention
toCallingConvention (Raw.CallingConvention CUInt
c) =
    case CUInt
c of
        (CUInt
0) -> CallingConvention
C
{-# LINE 646 "src/LLVM/FFI/Core.hsc" #-}
        (CUInt
8) -> CallingConvention
Fast
{-# LINE 647 "src/LLVM/FFI/Core.hsc" #-}
        (CUInt
9) -> CallingConvention
Cold
{-# LINE 648 "src/LLVM/FFI/Core.hsc" #-}
        (CUInt
64) -> CallingConvention
X86StdCall
{-# LINE 649 "src/LLVM/FFI/Core.hsc" #-}
        (CUInt
65) -> CallingConvention
X86FastCall
{-# LINE 650 "src/LLVM/FFI/Core.hsc" #-}
        CUInt
10 -> CallingConvention
GHC
        CUInt
_ ->
            String -> CallingConvention
forall a. HasCallStack => String -> a
error (String -> CallingConvention) -> String -> CallingConvention
forall a b. (a -> b) -> a -> b
$ String
"LLVM.Core.FFI.toCallingConvention: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                String
"unsupported calling convention" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CUInt -> String
forall a. Show a => a -> String
show CUInt
c

-- |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.
    | LinkOnceODRAutoHideLinkage -- ^Like LinkOnceODR, but possibly hidden.
    | 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.
    | LinkerPrivateWeakLinkage -- ^Like LinkerPrivate, but is weak.
    deriving (Int -> Linkage -> ShowS
[Linkage] -> ShowS
Linkage -> String
(Int -> Linkage -> ShowS)
-> (Linkage -> String) -> ([Linkage] -> ShowS) -> Show Linkage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Linkage -> ShowS
showsPrec :: Int -> Linkage -> ShowS
$cshow :: Linkage -> String
show :: Linkage -> String
$cshowList :: [Linkage] -> ShowS
showList :: [Linkage] -> ShowS
Show, Linkage -> Linkage -> Bool
(Linkage -> Linkage -> Bool)
-> (Linkage -> Linkage -> Bool) -> Eq Linkage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Linkage -> Linkage -> Bool
== :: Linkage -> Linkage -> Bool
$c/= :: Linkage -> Linkage -> Bool
/= :: Linkage -> Linkage -> Bool
Eq, Eq Linkage
Eq Linkage
-> (Linkage -> Linkage -> Ordering)
-> (Linkage -> Linkage -> Bool)
-> (Linkage -> Linkage -> Bool)
-> (Linkage -> Linkage -> Bool)
-> (Linkage -> Linkage -> Bool)
-> (Linkage -> Linkage -> Linkage)
-> (Linkage -> Linkage -> Linkage)
-> Ord Linkage
Linkage -> Linkage -> Bool
Linkage -> Linkage -> Ordering
Linkage -> Linkage -> Linkage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Linkage -> Linkage -> Ordering
compare :: Linkage -> Linkage -> Ordering
$c< :: Linkage -> Linkage -> Bool
< :: Linkage -> Linkage -> Bool
$c<= :: Linkage -> Linkage -> Bool
<= :: Linkage -> Linkage -> Bool
$c> :: Linkage -> Linkage -> Bool
> :: Linkage -> Linkage -> Bool
$c>= :: Linkage -> Linkage -> Bool
>= :: Linkage -> Linkage -> Bool
$cmax :: Linkage -> Linkage -> Linkage
max :: Linkage -> Linkage -> Linkage
$cmin :: Linkage -> Linkage -> Linkage
min :: Linkage -> Linkage -> Linkage
Ord, Int -> Linkage
Linkage -> Int
Linkage -> [Linkage]
Linkage -> Linkage
Linkage -> Linkage -> [Linkage]
Linkage -> Linkage -> Linkage -> [Linkage]
(Linkage -> Linkage)
-> (Linkage -> Linkage)
-> (Int -> Linkage)
-> (Linkage -> Int)
-> (Linkage -> [Linkage])
-> (Linkage -> Linkage -> [Linkage])
-> (Linkage -> Linkage -> [Linkage])
-> (Linkage -> Linkage -> Linkage -> [Linkage])
-> Enum Linkage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Linkage -> Linkage
succ :: Linkage -> Linkage
$cpred :: Linkage -> Linkage
pred :: Linkage -> Linkage
$ctoEnum :: Int -> Linkage
toEnum :: Int -> Linkage
$cfromEnum :: Linkage -> Int
fromEnum :: Linkage -> Int
$cenumFrom :: Linkage -> [Linkage]
enumFrom :: Linkage -> [Linkage]
$cenumFromThen :: Linkage -> Linkage -> [Linkage]
enumFromThen :: Linkage -> Linkage -> [Linkage]
$cenumFromTo :: Linkage -> Linkage -> [Linkage]
enumFromTo :: Linkage -> Linkage -> [Linkage]
$cenumFromThenTo :: Linkage -> Linkage -> Linkage -> [Linkage]
enumFromThenTo :: Linkage -> Linkage -> Linkage -> [Linkage]
Enum, Typeable)

fromLinkage :: Linkage -> Raw.Linkage
fromLinkage :: Linkage -> Linkage
fromLinkage Linkage
c =
    Word32 -> Linkage
Raw.Linkage (Word32 -> Linkage) -> Word32 -> Linkage
forall a b. (a -> b) -> a -> b
$
    case Linkage
c of
        Linkage
ExternalLinkage             -> (Word32
0)
{-# LINE 681 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
AvailableExternallyLinkage  -> (Word32
1)
{-# LINE 682 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
LinkOnceAnyLinkage          -> (Word32
2)
{-# LINE 683 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
LinkOnceODRLinkage          -> (Word32
3)
{-# LINE 684 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
LinkOnceODRAutoHideLinkage  -> (Word32
4)
{-# LINE 685 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
WeakAnyLinkage              -> (Word32
5)
{-# LINE 686 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
WeakODRLinkage              -> (Word32
6)
{-# LINE 687 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
AppendingLinkage            -> (Word32
7)
{-# LINE 688 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
InternalLinkage             -> (Word32
8)
{-# LINE 689 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
PrivateLinkage              -> (Word32
9)
{-# LINE 690 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
DLLImportLinkage            -> (Word32
10)
{-# LINE 691 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
DLLExportLinkage            -> (Word32
11)
{-# LINE 692 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
ExternalWeakLinkage         -> (Word32
12)
{-# LINE 693 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
GhostLinkage                -> (Word32
13)
{-# LINE 694 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
CommonLinkage               -> (Word32
14)
{-# LINE 695 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
LinkerPrivateLinkage        -> (Word32
15)
{-# LINE 696 "src/LLVM/FFI/Core.hsc" #-}
        Linkage
LinkerPrivateWeakLinkage    -> (Word32
16)
{-# LINE 697 "src/LLVM/FFI/Core.hsc" #-}

toLinkage :: Raw.Linkage -> Linkage
toLinkage :: Linkage -> Linkage
toLinkage (Raw.Linkage Word32
c) =
    case Word32
c of
        (Word32
0)             -> Linkage
ExternalLinkage
{-# LINE 702 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
1)  -> Linkage
AvailableExternallyLinkage
{-# LINE 703 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
2)          -> Linkage
LinkOnceAnyLinkage
{-# LINE 704 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
3)          -> Linkage
LinkOnceODRLinkage
{-# LINE 705 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
4)  -> Linkage
LinkOnceODRAutoHideLinkage
{-# LINE 706 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
5)              -> Linkage
WeakAnyLinkage
{-# LINE 707 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
6)              -> Linkage
WeakODRLinkage
{-# LINE 708 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
7)            -> Linkage
AppendingLinkage
{-# LINE 709 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
8)             -> Linkage
InternalLinkage
{-# LINE 710 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
9)              -> Linkage
PrivateLinkage
{-# LINE 711 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
10)            -> Linkage
DLLImportLinkage
{-# LINE 712 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
11)            -> Linkage
DLLExportLinkage
{-# LINE 713 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
12)         -> Linkage
ExternalWeakLinkage
{-# LINE 714 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
13)                -> Linkage
GhostLinkage
{-# LINE 715 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
14)               -> Linkage
CommonLinkage
{-# LINE 716 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
15)        -> Linkage
LinkerPrivateLinkage
{-# LINE 717 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
16)    -> Linkage
LinkerPrivateWeakLinkage
{-# LINE 718 "src/LLVM/FFI/Core.hsc" #-}
        Word32
_ -> String -> Linkage
forall a. HasCallStack => String -> a
error String
"toLinkage: bad value"

-- |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 (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Visibility -> ShowS
showsPrec :: Int -> Visibility -> ShowS
$cshow :: Visibility -> String
show :: Visibility -> String
$cshowList :: [Visibility] -> ShowS
showList :: [Visibility] -> ShowS
Show, Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
/= :: Visibility -> Visibility -> Bool
Eq, Eq Visibility
Eq Visibility
-> (Visibility -> Visibility -> Ordering)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Visibility)
-> (Visibility -> Visibility -> Visibility)
-> Ord Visibility
Visibility -> Visibility -> Bool
Visibility -> Visibility -> Ordering
Visibility -> Visibility -> Visibility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Visibility -> Visibility -> Ordering
compare :: Visibility -> Visibility -> Ordering
$c< :: Visibility -> Visibility -> Bool
< :: Visibility -> Visibility -> Bool
$c<= :: Visibility -> Visibility -> Bool
<= :: Visibility -> Visibility -> Bool
$c> :: Visibility -> Visibility -> Bool
> :: Visibility -> Visibility -> Bool
$c>= :: Visibility -> Visibility -> Bool
>= :: Visibility -> Visibility -> Bool
$cmax :: Visibility -> Visibility -> Visibility
max :: Visibility -> Visibility -> Visibility
$cmin :: Visibility -> Visibility -> Visibility
min :: Visibility -> Visibility -> Visibility
Ord, Int -> Visibility
Visibility -> Int
Visibility -> [Visibility]
Visibility -> Visibility
Visibility -> Visibility -> [Visibility]
Visibility -> Visibility -> Visibility -> [Visibility]
(Visibility -> Visibility)
-> (Visibility -> Visibility)
-> (Int -> Visibility)
-> (Visibility -> Int)
-> (Visibility -> [Visibility])
-> (Visibility -> Visibility -> [Visibility])
-> (Visibility -> Visibility -> [Visibility])
-> (Visibility -> Visibility -> Visibility -> [Visibility])
-> Enum Visibility
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Visibility -> Visibility
succ :: Visibility -> Visibility
$cpred :: Visibility -> Visibility
pred :: Visibility -> Visibility
$ctoEnum :: Int -> Visibility
toEnum :: Int -> Visibility
$cfromEnum :: Visibility -> Int
fromEnum :: Visibility -> Int
$cenumFrom :: Visibility -> [Visibility]
enumFrom :: Visibility -> [Visibility]
$cenumFromThen :: Visibility -> Visibility -> [Visibility]
enumFromThen :: Visibility -> Visibility -> [Visibility]
$cenumFromTo :: Visibility -> Visibility -> [Visibility]
enumFromTo :: Visibility -> Visibility -> [Visibility]
$cenumFromThenTo :: Visibility -> Visibility -> Visibility -> [Visibility]
enumFromThenTo :: Visibility -> Visibility -> Visibility -> [Visibility]
Enum)

fromVisibility :: Visibility -> Raw.Visibility
fromVisibility :: Visibility -> Visibility
fromVisibility Visibility
c =
    Word32 -> Visibility
Raw.Visibility (Word32 -> Visibility) -> Word32 -> Visibility
forall a b. (a -> b) -> a -> b
$
    case Visibility
c of
        Visibility
DefaultVisibility   -> (Word32
0)
{-# LINE 732 "src/LLVM/FFI/Core.hsc" #-}
        Visibility
HiddenVisibility    -> (Word32
1)
{-# LINE 733 "src/LLVM/FFI/Core.hsc" #-}
        Visibility
ProtectedVisibility -> (Word32
2)
{-# LINE 734 "src/LLVM/FFI/Core.hsc" #-}

toVisibility :: Raw.Visibility -> Visibility
toVisibility :: Visibility -> Visibility
toVisibility (Raw.Visibility Word32
c) =
    case Word32
c of
        (Word32
0)   -> Visibility
DefaultVisibility
{-# LINE 739 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
1)    -> Visibility
HiddenVisibility
{-# LINE 740 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
2) -> Visibility
ProtectedVisibility
{-# LINE 741 "src/LLVM/FFI/Core.hsc" #-}
        Word32
_ -> String -> Visibility
forall a. HasCallStack => String -> a
error String
"toVisibility: bad value"


data IntPredicate =
      IntEQ   -- ^ equal
    | IntNE   -- ^ not equal
    | IntUGT  -- ^ unsigned greater than
    | IntUGE  -- ^ unsigned greater or equal
    | IntULT  -- ^ unsigned less than
    | IntULE  -- ^ unsigned less or equal
    | IntSGT  -- ^ signed greater than
    | IntSGE  -- ^ signed greater or equal
    | IntSLT  -- ^ signed less than
    | IntSLE  -- ^ signed less or equal
    deriving (IntPredicate -> IntPredicate -> Bool
(IntPredicate -> IntPredicate -> Bool)
-> (IntPredicate -> IntPredicate -> Bool) -> Eq IntPredicate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntPredicate -> IntPredicate -> Bool
== :: IntPredicate -> IntPredicate -> Bool
$c/= :: IntPredicate -> IntPredicate -> Bool
/= :: IntPredicate -> IntPredicate -> Bool
Eq, Eq IntPredicate
Eq IntPredicate
-> (IntPredicate -> IntPredicate -> Ordering)
-> (IntPredicate -> IntPredicate -> Bool)
-> (IntPredicate -> IntPredicate -> Bool)
-> (IntPredicate -> IntPredicate -> Bool)
-> (IntPredicate -> IntPredicate -> Bool)
-> (IntPredicate -> IntPredicate -> IntPredicate)
-> (IntPredicate -> IntPredicate -> IntPredicate)
-> Ord IntPredicate
IntPredicate -> IntPredicate -> Bool
IntPredicate -> IntPredicate -> Ordering
IntPredicate -> IntPredicate -> IntPredicate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IntPredicate -> IntPredicate -> Ordering
compare :: IntPredicate -> IntPredicate -> Ordering
$c< :: IntPredicate -> IntPredicate -> Bool
< :: IntPredicate -> IntPredicate -> Bool
$c<= :: IntPredicate -> IntPredicate -> Bool
<= :: IntPredicate -> IntPredicate -> Bool
$c> :: IntPredicate -> IntPredicate -> Bool
> :: IntPredicate -> IntPredicate -> Bool
$c>= :: IntPredicate -> IntPredicate -> Bool
>= :: IntPredicate -> IntPredicate -> Bool
$cmax :: IntPredicate -> IntPredicate -> IntPredicate
max :: IntPredicate -> IntPredicate -> IntPredicate
$cmin :: IntPredicate -> IntPredicate -> IntPredicate
min :: IntPredicate -> IntPredicate -> IntPredicate
Ord, Int -> IntPredicate
IntPredicate -> Int
IntPredicate -> [IntPredicate]
IntPredicate -> IntPredicate
IntPredicate -> IntPredicate -> [IntPredicate]
IntPredicate -> IntPredicate -> IntPredicate -> [IntPredicate]
(IntPredicate -> IntPredicate)
-> (IntPredicate -> IntPredicate)
-> (Int -> IntPredicate)
-> (IntPredicate -> Int)
-> (IntPredicate -> [IntPredicate])
-> (IntPredicate -> IntPredicate -> [IntPredicate])
-> (IntPredicate -> IntPredicate -> [IntPredicate])
-> (IntPredicate -> IntPredicate -> IntPredicate -> [IntPredicate])
-> Enum IntPredicate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IntPredicate -> IntPredicate
succ :: IntPredicate -> IntPredicate
$cpred :: IntPredicate -> IntPredicate
pred :: IntPredicate -> IntPredicate
$ctoEnum :: Int -> IntPredicate
toEnum :: Int -> IntPredicate
$cfromEnum :: IntPredicate -> Int
fromEnum :: IntPredicate -> Int
$cenumFrom :: IntPredicate -> [IntPredicate]
enumFrom :: IntPredicate -> [IntPredicate]
$cenumFromThen :: IntPredicate -> IntPredicate -> [IntPredicate]
enumFromThen :: IntPredicate -> IntPredicate -> [IntPredicate]
$cenumFromTo :: IntPredicate -> IntPredicate -> [IntPredicate]
enumFromTo :: IntPredicate -> IntPredicate -> [IntPredicate]
$cenumFromThenTo :: IntPredicate -> IntPredicate -> IntPredicate -> [IntPredicate]
enumFromThenTo :: IntPredicate -> IntPredicate -> IntPredicate -> [IntPredicate]
Enum, Int -> IntPredicate -> ShowS
[IntPredicate] -> ShowS
IntPredicate -> String
(Int -> IntPredicate -> ShowS)
-> (IntPredicate -> String)
-> ([IntPredicate] -> ShowS)
-> Show IntPredicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntPredicate -> ShowS
showsPrec :: Int -> IntPredicate -> ShowS
$cshow :: IntPredicate -> String
show :: IntPredicate -> String
$cshowList :: [IntPredicate] -> ShowS
showList :: [IntPredicate] -> ShowS
Show, Typeable)

fromIntPredicate :: IntPredicate -> Raw.IntPredicate
fromIntPredicate :: IntPredicate -> IntPredicate
fromIntPredicate IntPredicate
p =
    Word32 -> IntPredicate
Raw.IntPredicate (Word32 -> IntPredicate) -> Word32 -> IntPredicate
forall a b. (a -> b) -> a -> b
$
    case IntPredicate
p of
        IntPredicate
IntEQ  -> (Word32
32)
{-# LINE 762 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntNE  -> (Word32
33)
{-# LINE 763 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntUGT -> (Word32
34)
{-# LINE 764 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntUGE -> (Word32
35)
{-# LINE 765 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntULT -> (Word32
36)
{-# LINE 766 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntULE -> (Word32
37)
{-# LINE 767 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntSGT -> (Word32
38)
{-# LINE 768 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntSGE -> (Word32
39)
{-# LINE 769 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntSLT -> (Word32
40)
{-# LINE 770 "src/LLVM/FFI/Core.hsc" #-}
        IntPredicate
IntSLE -> (Word32
41)
{-# LINE 771 "src/LLVM/FFI/Core.hsc" #-}

toIntPredicate :: Raw.IntPredicate -> IntPredicate
toIntPredicate :: IntPredicate -> IntPredicate
toIntPredicate (Raw.IntPredicate Word32
p) =
    case Word32
p of
        (Word32
32) -> IntPredicate
IntEQ
{-# LINE 776 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
33) -> IntPredicate
IntNE
{-# LINE 777 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
34) -> IntPredicate
IntUGT
{-# LINE 778 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
35) -> IntPredicate
IntUGE
{-# LINE 779 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
36) -> IntPredicate
IntULT
{-# LINE 780 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
37) -> IntPredicate
IntULE
{-# LINE 781 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
38) -> IntPredicate
IntSGT
{-# LINE 782 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
39) -> IntPredicate
IntSGE
{-# LINE 783 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
40) -> IntPredicate
IntSLT
{-# LINE 784 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
41) -> IntPredicate
IntSLE
{-# LINE 785 "src/LLVM/FFI/Core.hsc" #-}
        Word32
_ -> String -> IntPredicate
forall a. HasCallStack => String -> a
error String
"toIntPredicate: bad value"

data FPPredicate =
      FPFalse -- ^ Always false (always folded)
    | FPOEQ   -- ^ True if ordered and equal
    | FPOGT   -- ^ True if ordered and greater than
    | FPOGE   -- ^ True if ordered and greater than or equal
    | FPOLT   -- ^ True if ordered and less than
    | FPOLE   -- ^ True if ordered and less than or equal
    | FPONE   -- ^ True if ordered and operands are unequal
    | FPORD   -- ^ True if ordered (no nans)
    | FPUNO   -- ^ True if unordered: isnan(X) | isnan(Y)
    | FPUEQ   -- ^ True if unordered or equal
    | FPUGT   -- ^ True if unordered or greater than
    | FPUGE   -- ^ True if unordered, greater than, or equal
    | FPULT   -- ^ True if unordered or less than
    | FPULE   -- ^ True if unordered, less than, or equal
    | FPUNE   -- ^ True if unordered or not equal
    | FPTrue  -- ^ Always true (always folded)
    deriving (FPPredicate -> FPPredicate -> Bool
(FPPredicate -> FPPredicate -> Bool)
-> (FPPredicate -> FPPredicate -> Bool) -> Eq FPPredicate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FPPredicate -> FPPredicate -> Bool
== :: FPPredicate -> FPPredicate -> Bool
$c/= :: FPPredicate -> FPPredicate -> Bool
/= :: FPPredicate -> FPPredicate -> Bool
Eq, Eq FPPredicate
Eq FPPredicate
-> (FPPredicate -> FPPredicate -> Ordering)
-> (FPPredicate -> FPPredicate -> Bool)
-> (FPPredicate -> FPPredicate -> Bool)
-> (FPPredicate -> FPPredicate -> Bool)
-> (FPPredicate -> FPPredicate -> Bool)
-> (FPPredicate -> FPPredicate -> FPPredicate)
-> (FPPredicate -> FPPredicate -> FPPredicate)
-> Ord FPPredicate
FPPredicate -> FPPredicate -> Bool
FPPredicate -> FPPredicate -> Ordering
FPPredicate -> FPPredicate -> FPPredicate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FPPredicate -> FPPredicate -> Ordering
compare :: FPPredicate -> FPPredicate -> Ordering
$c< :: FPPredicate -> FPPredicate -> Bool
< :: FPPredicate -> FPPredicate -> Bool
$c<= :: FPPredicate -> FPPredicate -> Bool
<= :: FPPredicate -> FPPredicate -> Bool
$c> :: FPPredicate -> FPPredicate -> Bool
> :: FPPredicate -> FPPredicate -> Bool
$c>= :: FPPredicate -> FPPredicate -> Bool
>= :: FPPredicate -> FPPredicate -> Bool
$cmax :: FPPredicate -> FPPredicate -> FPPredicate
max :: FPPredicate -> FPPredicate -> FPPredicate
$cmin :: FPPredicate -> FPPredicate -> FPPredicate
min :: FPPredicate -> FPPredicate -> FPPredicate
Ord, Int -> FPPredicate
FPPredicate -> Int
FPPredicate -> [FPPredicate]
FPPredicate -> FPPredicate
FPPredicate -> FPPredicate -> [FPPredicate]
FPPredicate -> FPPredicate -> FPPredicate -> [FPPredicate]
(FPPredicate -> FPPredicate)
-> (FPPredicate -> FPPredicate)
-> (Int -> FPPredicate)
-> (FPPredicate -> Int)
-> (FPPredicate -> [FPPredicate])
-> (FPPredicate -> FPPredicate -> [FPPredicate])
-> (FPPredicate -> FPPredicate -> [FPPredicate])
-> (FPPredicate -> FPPredicate -> FPPredicate -> [FPPredicate])
-> Enum FPPredicate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FPPredicate -> FPPredicate
succ :: FPPredicate -> FPPredicate
$cpred :: FPPredicate -> FPPredicate
pred :: FPPredicate -> FPPredicate
$ctoEnum :: Int -> FPPredicate
toEnum :: Int -> FPPredicate
$cfromEnum :: FPPredicate -> Int
fromEnum :: FPPredicate -> Int
$cenumFrom :: FPPredicate -> [FPPredicate]
enumFrom :: FPPredicate -> [FPPredicate]
$cenumFromThen :: FPPredicate -> FPPredicate -> [FPPredicate]
enumFromThen :: FPPredicate -> FPPredicate -> [FPPredicate]
$cenumFromTo :: FPPredicate -> FPPredicate -> [FPPredicate]
enumFromTo :: FPPredicate -> FPPredicate -> [FPPredicate]
$cenumFromThenTo :: FPPredicate -> FPPredicate -> FPPredicate -> [FPPredicate]
enumFromThenTo :: FPPredicate -> FPPredicate -> FPPredicate -> [FPPredicate]
Enum, Int -> FPPredicate -> ShowS
[FPPredicate] -> ShowS
FPPredicate -> String
(Int -> FPPredicate -> ShowS)
-> (FPPredicate -> String)
-> ([FPPredicate] -> ShowS)
-> Show FPPredicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FPPredicate -> ShowS
showsPrec :: Int -> FPPredicate -> ShowS
$cshow :: FPPredicate -> String
show :: FPPredicate -> String
$cshowList :: [FPPredicate] -> ShowS
showList :: [FPPredicate] -> ShowS
Show, Typeable)

fromRealPredicate :: FPPredicate -> Raw.RealPredicate
fromRealPredicate :: FPPredicate -> RealPredicate
fromRealPredicate FPPredicate
p =
    Word32 -> RealPredicate
Raw.RealPredicate (Word32 -> RealPredicate) -> Word32 -> RealPredicate
forall a b. (a -> b) -> a -> b
$
    case FPPredicate
p of
        FPPredicate
FPFalse -> (Word32
0)
{-# LINE 811 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPTrue  -> (Word32
15)
{-# LINE 812 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPOEQ -> (Word32
1)
{-# LINE 813 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPOGT -> (Word32
2)
{-# LINE 814 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPOGE -> (Word32
3)
{-# LINE 815 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPOLT -> (Word32
4)
{-# LINE 816 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPOLE -> (Word32
5)
{-# LINE 817 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPONE -> (Word32
6)
{-# LINE 818 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPORD -> (Word32
7)
{-# LINE 819 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPUNO -> (Word32
8)
{-# LINE 820 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPUEQ -> (Word32
9)
{-# LINE 821 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPUGT -> (Word32
10)
{-# LINE 822 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPUGE -> (Word32
11)
{-# LINE 823 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPULT -> (Word32
12)
{-# LINE 824 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPULE -> (Word32
13)
{-# LINE 825 "src/LLVM/FFI/Core.hsc" #-}
        FPPredicate
FPUNE -> (Word32
14)
{-# LINE 826 "src/LLVM/FFI/Core.hsc" #-}

toRealPredicate :: Raw.RealPredicate -> FPPredicate
toRealPredicate :: RealPredicate -> FPPredicate
toRealPredicate (Raw.RealPredicate Word32
p) =
    case Word32
p of
        (Word32
0) -> FPPredicate
FPFalse
{-# LINE 831 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
15) -> FPPredicate
FPTrue
{-# LINE 832 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
1) -> FPPredicate
FPOEQ
{-# LINE 833 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
2) -> FPPredicate
FPOGT
{-# LINE 834 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
3) -> FPPredicate
FPOGE
{-# LINE 835 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
4) -> FPPredicate
FPOLT
{-# LINE 836 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
5) -> FPPredicate
FPOLE
{-# LINE 837 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
6) -> FPPredicate
FPONE
{-# LINE 838 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
7) -> FPPredicate
FPORD
{-# LINE 839 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
8) -> FPPredicate
FPUNO
{-# LINE 840 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
9) -> FPPredicate
FPUEQ
{-# LINE 841 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
10) -> FPPredicate
FPUGT
{-# LINE 842 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
11) -> FPPredicate
FPUGE
{-# LINE 843 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
12) -> FPPredicate
FPULT
{-# LINE 844 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
13) -> FPPredicate
FPULE
{-# LINE 845 "src/LLVM/FFI/Core.hsc" #-}
        (Word32
14) -> FPPredicate
FPUNE
{-# LINE 846 "src/LLVM/FFI/Core.hsc" #-}
        Word32
_ -> String -> FPPredicate
forall a. HasCallStack => String -> a
error String
"toRealPredicate: bad value"



-- ** Error Handling
disposeMessage :: CString -> IO ()
disposeMessage :: CString -> IO ()
disposeMessage = CString -> IO ()
Raw.disposeMessage

-- ** Contexts
contextCreate :: IO ContextRef
contextCreate :: IO ContextRef
contextCreate = IO ContextRef
Raw.contextCreate

getGlobalContext :: IO ContextRef
getGlobalContext :: IO ContextRef
getGlobalContext = IO ContextRef
Raw.getGlobalContext

contextDispose :: ContextRef -> IO ()
contextDispose :: ContextRef -> IO ()
contextDispose = ContextRef -> IO ()
Raw.contextDispose

getMDKindIDInContext :: ContextRef -> CString -> CUInt -> IO CUInt
getMDKindIDInContext :: ContextRef -> CString -> CUInt -> IO CUInt
getMDKindIDInContext = ContextRef -> CString -> CUInt -> IO CUInt
Raw.getMDKindIDInContext

getMDKindID :: CString -> CUInt -> IO CUInt
getMDKindID :: CString -> CUInt -> IO CUInt
getMDKindID = CString -> CUInt -> IO CUInt
Raw.getMDKindID

-- ** Attributes

newtype AttributeKind = AttributeKind CUInt

getEnumAttributeKindForName :: CString -> C.CSize -> IO AttributeKind
getEnumAttributeKindForName :: CString -> CSize -> IO AttributeKind
getEnumAttributeKindForName CString
name CSize
slen =
   (CUInt -> AttributeKind) -> IO CUInt -> IO AttributeKind
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> AttributeKind
AttributeKind (IO CUInt -> IO AttributeKind) -> IO CUInt -> IO AttributeKind
forall a b. (a -> b) -> a -> b
$ CString -> CSize -> IO CUInt
Raw.getEnumAttributeKindForName CString
name CSize
slen

getLastEnumAttributeKind :: IO AttributeKind
getLastEnumAttributeKind :: IO AttributeKind
getLastEnumAttributeKind = (CUInt -> AttributeKind) -> IO CUInt -> IO AttributeKind
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> AttributeKind
AttributeKind (IO CUInt -> IO AttributeKind) -> IO CUInt -> IO AttributeKind
forall a b. (a -> b) -> a -> b
$ IO CUInt
Raw.getLastEnumAttributeKind

createEnumAttribute :: ContextRef -> AttributeKind -> Word64 -> IO AttributeRef
createEnumAttribute :: ContextRef -> AttributeKind -> Word64 -> IO AttributeRef
createEnumAttribute ContextRef
c (AttributeKind CUInt
kindId) = ContextRef -> CUInt -> Word64 -> IO AttributeRef
Raw.createEnumAttribute ContextRef
c CUInt
kindId

getEnumAttributeKind :: AttributeRef -> IO AttributeKind
getEnumAttributeKind :: AttributeRef -> IO AttributeKind
getEnumAttributeKind = (CUInt -> AttributeKind) -> IO CUInt -> IO AttributeKind
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> AttributeKind
AttributeKind (IO CUInt -> IO AttributeKind)
-> (AttributeRef -> IO CUInt) -> AttributeRef -> IO AttributeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeRef -> IO CUInt
Raw.getEnumAttributeKind

getEnumAttributeValue :: AttributeRef -> IO Word64
getEnumAttributeValue :: AttributeRef -> IO Word64
getEnumAttributeValue = AttributeRef -> IO Word64
Raw.getEnumAttributeValue

createStringAttribute ::
   ContextRef -> CString -> CUInt -> CString -> CUInt -> IO AttributeRef
createStringAttribute :: ContextRef
-> CString -> CUInt -> CString -> CUInt -> IO AttributeRef
createStringAttribute = ContextRef
-> CString -> CUInt -> CString -> CUInt -> IO AttributeRef
Raw.createStringAttribute

getStringAttributeKind :: AttributeRef -> Ptr CUInt -> IO CString
getStringAttributeKind :: AttributeRef -> Ptr CUInt -> IO CString
getStringAttributeKind = AttributeRef -> Ptr CUInt -> IO CString
Raw.getStringAttributeKind

getStringAttributeValue :: AttributeRef -> Ptr CUInt -> IO CString
getStringAttributeValue :: AttributeRef -> Ptr CUInt -> IO CString
getStringAttributeValue = AttributeRef -> Ptr CUInt -> IO CString
Raw.getStringAttributeValue

isEnumAttribute :: AttributeRef -> IO LLVM.Bool
isEnumAttribute :: AttributeRef -> IO Bool
isEnumAttribute = AttributeRef -> IO Bool
Raw.isEnumAttribute

isStringAttribute :: AttributeRef -> IO LLVM.Bool
isStringAttribute :: AttributeRef -> IO Bool
isStringAttribute = AttributeRef -> IO Bool
Raw.isStringAttribute

-- ** Modules
moduleCreateWithName :: CString -> IO ModuleRef
moduleCreateWithName :: CString -> IO ModuleRef
moduleCreateWithName = CString -> IO ModuleRef
Raw.moduleCreateWithName

moduleCreateWithNameInContext :: CString -> ContextRef -> IO ModuleRef
moduleCreateWithNameInContext :: CString -> ContextRef -> IO ModuleRef
moduleCreateWithNameInContext = CString -> ContextRef -> IO ModuleRef
Raw.moduleCreateWithNameInContext

disposeModule :: ModuleRef -> IO ()
disposeModule :: ModuleRef -> IO ()
disposeModule = ModuleRef -> IO ()
Raw.disposeModule

foreign import ccall unsafe "&LLVMDisposeModule" ptrDisposeModule
    :: LLVM.FinalizerPtr Raw.Module

-- ** Data Layout
getDataLayout :: ModuleRef -> IO CString
getDataLayout :: ModuleRef -> IO CString
getDataLayout = ModuleRef -> IO CString
Raw.getDataLayout

setDataLayout :: ModuleRef -> CString -> IO ()
setDataLayout :: ModuleRef -> CString -> IO ()
setDataLayout = ModuleRef -> CString -> IO ()
Raw.setDataLayout


-- ** Targets
getTarget :: ModuleRef -> IO CString
getTarget :: ModuleRef -> IO CString
getTarget = ModuleRef -> IO CString
Raw.getTarget

setTarget :: ModuleRef -> CString -> IO ()
setTarget :: ModuleRef -> CString -> IO ()
setTarget = ModuleRef -> CString -> IO ()
Raw.setTarget


-- ** Dump module
dumpModule :: ModuleRef -> IO ()
dumpModule :: ModuleRef -> IO ()
dumpModule = ModuleRef -> IO ()
Raw.dumpModule

setModuleInlineAsm :: ModuleRef -> CString -> IO ()
setModuleInlineAsm :: ModuleRef -> CString -> IO ()
setModuleInlineAsm = ModuleRef -> CString -> IO ()
Raw.setModuleInlineAsm

getModuleContext :: ModuleRef -> IO ContextRef
getModuleContext :: ModuleRef -> IO ContextRef
getModuleContext = ModuleRef -> IO ContextRef
Raw.getModuleContext


-- ** Functions
addFunction :: ModuleRef -> CString -> TypeRef -> IO FunctionRef
addFunction :: ModuleRef -> CString -> TypeRef -> IO FunctionRef
addFunction = ModuleRef -> CString -> TypeRef -> IO FunctionRef
Raw.addFunction

getNamedFunction :: ModuleRef -> CString -> IO FunctionRef
getNamedFunction :: ModuleRef -> CString -> IO FunctionRef
getNamedFunction = ModuleRef -> CString -> IO FunctionRef
Raw.getNamedFunction

getFirstFunction :: ModuleRef -> IO ValueRef
getFirstFunction :: ModuleRef -> IO FunctionRef
getFirstFunction = ModuleRef -> IO FunctionRef
Raw.getFirstFunction

getLastFunction :: ModuleRef -> IO ValueRef
getLastFunction :: ModuleRef -> IO FunctionRef
getLastFunction = ModuleRef -> IO FunctionRef
Raw.getLastFunction

getNextFunction :: ValueRef -> IO ValueRef
getNextFunction :: FunctionRef -> IO FunctionRef
getNextFunction = FunctionRef -> IO FunctionRef
Raw.getNextFunction

getPreviousFunction :: ValueRef -> IO ValueRef
getPreviousFunction :: FunctionRef -> IO FunctionRef
getPreviousFunction = FunctionRef -> IO FunctionRef
Raw.getPreviousFunction


-- ** Types
getTypeKindRaw :: TypeRef -> IO Raw.TypeKind
getTypeKindRaw :: TypeRef -> IO TypeKind
getTypeKindRaw = TypeRef -> IO TypeKind
Raw.getTypeKind

typeIsSized :: TypeRef -> IO LLVM.Bool
typeIsSized :: TypeRef -> IO Bool
typeIsSized = TypeRef -> IO Bool
Raw.typeIsSized

getTypeContext :: TypeRef -> IO ContextRef
getTypeContext :: TypeRef -> IO ContextRef
getTypeContext = TypeRef -> IO ContextRef
Raw.getTypeContext


-- ** Integer types
int1TypeInContext :: ContextRef -> IO TypeRef
int1TypeInContext :: ContextRef -> IO TypeRef
int1TypeInContext = ContextRef -> IO TypeRef
Raw.int1TypeInContext

int8TypeInContext :: ContextRef -> IO TypeRef
int8TypeInContext :: ContextRef -> IO TypeRef
int8TypeInContext = ContextRef -> IO TypeRef
Raw.int8TypeInContext

int16TypeInContext :: ContextRef -> IO TypeRef
int16TypeInContext :: ContextRef -> IO TypeRef
int16TypeInContext = ContextRef -> IO TypeRef
Raw.int16TypeInContext

int32TypeInContext :: ContextRef -> IO TypeRef
int32TypeInContext :: ContextRef -> IO TypeRef
int32TypeInContext = ContextRef -> IO TypeRef
Raw.int32TypeInContext

int64TypeInContext :: ContextRef -> IO TypeRef
int64TypeInContext :: ContextRef -> IO TypeRef
int64TypeInContext = ContextRef -> IO TypeRef
Raw.int64TypeInContext

intTypeInContext :: ContextRef -> CUInt -> IO TypeRef
intTypeInContext :: ContextRef -> CUInt -> IO TypeRef
intTypeInContext = ContextRef -> CUInt -> IO TypeRef
Raw.intTypeInContext


int1Type :: IO TypeRef
int1Type :: IO TypeRef
int1Type = IO TypeRef
Raw.int1Type
int8Type :: IO TypeRef
int8Type :: IO TypeRef
int8Type = IO TypeRef
Raw.int8Type
int16Type :: IO TypeRef
int16Type :: IO TypeRef
int16Type = IO TypeRef
Raw.int16Type
int32Type :: IO TypeRef
int32Type :: IO TypeRef
int32Type = IO TypeRef
Raw.int32Type
int64Type :: IO TypeRef
int64Type :: IO TypeRef
int64Type = IO TypeRef
Raw.int64Type
integerType :: CUInt -> IO TypeRef
integerType :: CUInt -> IO TypeRef
integerType = CUInt -> IO TypeRef
Raw.intType
getIntTypeWidth :: TypeRef -> IO CUInt
getIntTypeWidth :: TypeRef -> IO CUInt
getIntTypeWidth = TypeRef -> IO CUInt
Raw.getIntTypeWidth


-- ** Real types
floatTypeInContext :: ContextRef -> IO TypeRef
floatTypeInContext :: ContextRef -> IO TypeRef
floatTypeInContext = ContextRef -> IO TypeRef
Raw.floatTypeInContext

doubleTypeInContext :: ContextRef -> IO TypeRef
doubleTypeInContext :: ContextRef -> IO TypeRef
doubleTypeInContext = ContextRef -> IO TypeRef
Raw.doubleTypeInContext

x86FP80TypeInContext :: ContextRef -> IO TypeRef
x86FP80TypeInContext :: ContextRef -> IO TypeRef
x86FP80TypeInContext = ContextRef -> IO TypeRef
Raw.x86FP80TypeInContext

fp128TypeInContext :: ContextRef -> IO TypeRef
fp128TypeInContext :: ContextRef -> IO TypeRef
fp128TypeInContext = ContextRef -> IO TypeRef
Raw.fP128TypeInContext

ppcFP128TypeInContext :: ContextRef -> IO TypeRef
ppcFP128TypeInContext :: ContextRef -> IO TypeRef
ppcFP128TypeInContext = ContextRef -> IO TypeRef
Raw.pPCFP128TypeInContext


floatType :: IO TypeRef
floatType :: IO TypeRef
floatType = IO TypeRef
Raw.floatType

doubleType :: IO TypeRef
doubleType :: IO TypeRef
doubleType = IO TypeRef
Raw.doubleType

x86FP80Type :: IO TypeRef
x86FP80Type :: IO TypeRef
x86FP80Type = IO TypeRef
Raw.x86FP80Type

fp128Type :: IO TypeRef
fp128Type :: IO TypeRef
fp128Type = IO TypeRef
Raw.fP128Type

ppcFP128Type :: IO TypeRef
ppcFP128Type :: IO TypeRef
ppcFP128Type = IO TypeRef
Raw.pPCFP128Type


-- ** Function types
-- | Create a function type.
functionType
        :: TypeRef              -- ^ return type
        -> Ptr TypeRef          -- ^ array of argument types
        -> CUInt                -- ^ number of elements in array
        -> LLVM.Bool            -- ^ non-zero if function is varargs
        -> IO TypeRef
functionType :: TypeRef -> Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
functionType = TypeRef -> Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
Raw.functionType

-- | Indicate whether a function takes varargs.
isFunctionVarArg :: TypeRef -> IO LLVM.Bool
isFunctionVarArg :: TypeRef -> IO Bool
isFunctionVarArg = TypeRef -> IO Bool
Raw.isFunctionVarArg

-- | Give a function's return type.
getReturnType :: TypeRef -> IO TypeRef
getReturnType :: TypeRef -> IO TypeRef
getReturnType = TypeRef -> IO TypeRef
Raw.getReturnType

-- | Give the number of fixed parameters that a function takes.
countParamTypes :: TypeRef -> IO CUInt
countParamTypes :: TypeRef -> IO CUInt
countParamTypes = TypeRef -> IO CUInt
Raw.countParamTypes

-- | Fill out an array with the types of a function's fixed
-- parameters.
getParamTypes     :: TypeRef -> Ptr TypeRef -> IO ()
getParamTypes :: TypeRef -> Ptr TypeRef -> IO ()
getParamTypes = TypeRef -> Ptr TypeRef -> IO ()
Raw.getParamTypes


-- ** Struct Raw.Type
structTypeInContext :: ContextRef -> Ptr TypeRef -> CUInt -> LLVM.Bool -> IO TypeRef
structTypeInContext :: ContextRef -> Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
structTypeInContext = ContextRef -> Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
Raw.structTypeInContext

structType :: Ptr TypeRef -> CUInt -> LLVM.Bool -> IO TypeRef
structType :: Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
structType = Ptr TypeRef -> CUInt -> Bool -> IO TypeRef
Raw.structType

structCreateNamed :: ContextRef -> CString -> IO TypeRef
structCreateNamed :: ContextRef -> CString -> IO TypeRef
structCreateNamed = ContextRef -> CString -> IO TypeRef
Raw.structCreateNamed

getStructName :: TypeRef -> IO CString
getStructName :: TypeRef -> IO CString
getStructName = TypeRef -> IO CString
Raw.getStructName

structSetBody :: TypeRef -> Ptr TypeRef -> CUInt -> LLVM.Bool -> IO ()
structSetBody :: TypeRef -> Ptr TypeRef -> CUInt -> Bool -> IO ()
structSetBody = TypeRef -> Ptr TypeRef -> CUInt -> Bool -> IO ()
Raw.structSetBody

countStructElementTypes :: TypeRef -> IO CUInt
countStructElementTypes :: TypeRef -> IO CUInt
countStructElementTypes = TypeRef -> IO CUInt
Raw.countStructElementTypes

getStructElementTypes :: TypeRef -> Ptr TypeRef -> IO ()
getStructElementTypes :: TypeRef -> Ptr TypeRef -> IO ()
getStructElementTypes = TypeRef -> Ptr TypeRef -> IO ()
Raw.getStructElementTypes

isPackedStruct :: TypeRef -> IO LLVM.Bool
isPackedStruct :: TypeRef -> IO Bool
isPackedStruct = TypeRef -> IO Bool
Raw.isPackedStruct

isOpaqueStruct :: TypeRef -> IO LLVM.Bool
isOpaqueStruct :: TypeRef -> IO Bool
isOpaqueStruct = TypeRef -> IO Bool
Raw.isOpaqueStruct

getTypeByName :: ModuleRef -> CString -> IO TypeRef
getTypeByName :: ModuleRef -> CString -> IO TypeRef
getTypeByName = ModuleRef -> CString -> IO TypeRef
Raw.getTypeByName


-- ** Array, Pointer, and Vector types
arrayType
    :: TypeRef                  -- ^ element type
    -> CUInt                    -- ^ element count
    -> IO TypeRef
arrayType :: TypeRef -> CUInt -> IO TypeRef
arrayType = TypeRef -> CUInt -> IO TypeRef
Raw.arrayType

pointerType
    :: TypeRef                  -- ^ pointed-to type
    -> CUInt                    -- ^ address space
    -> IO TypeRef
pointerType :: TypeRef -> CUInt -> IO TypeRef
pointerType = TypeRef -> CUInt -> IO TypeRef
Raw.pointerType

vectorType
    :: TypeRef                  -- ^ element type
    -> CUInt                    -- ^ element count
    -> IO TypeRef
vectorType :: TypeRef -> CUInt -> IO TypeRef
vectorType = TypeRef -> CUInt -> IO TypeRef
Raw.vectorType


-- | Get the type of a sequential type's elements.
getElementType :: TypeRef -> IO TypeRef
getElementType :: TypeRef -> IO TypeRef
getElementType = TypeRef -> IO TypeRef
Raw.getElementType

getArrayLength :: TypeRef -> IO CUInt
getArrayLength :: TypeRef -> IO CUInt
getArrayLength = TypeRef -> IO CUInt
Raw.getArrayLength

getPointerAddressSpace :: TypeRef -> IO CUInt
getPointerAddressSpace :: TypeRef -> IO CUInt
getPointerAddressSpace = TypeRef -> IO CUInt
Raw.getPointerAddressSpace

getVectorSize :: TypeRef -> IO CUInt
getVectorSize :: TypeRef -> IO CUInt
getVectorSize = TypeRef -> IO CUInt
Raw.getVectorSize


-- ** Other Types

voidTypeInContext :: ContextRef -> IO TypeRef
voidTypeInContext :: ContextRef -> IO TypeRef
voidTypeInContext = ContextRef -> IO TypeRef
Raw.voidTypeInContext

labelTypeInContext :: ContextRef -> IO TypeRef
labelTypeInContext :: ContextRef -> IO TypeRef
labelTypeInContext = ContextRef -> IO TypeRef
Raw.labelTypeInContext


foreign import ccall unsafe "LLVMVoidType" voidType :: IO TypeRef
foreign import ccall unsafe "LLVMLabelType" labelType :: IO TypeRef

-- ** Values
typeOf :: ValueRef -> IO TypeRef
typeOf :: FunctionRef -> IO TypeRef
typeOf = FunctionRef -> IO TypeRef
Raw.typeOf

getValueName :: ValueRef -> IO CString
getValueName :: FunctionRef -> IO CString
getValueName = FunctionRef -> IO CString
Raw.getValueName

setValueName :: ValueRef -> CString -> IO ()
setValueName :: FunctionRef -> CString -> IO ()
setValueName = FunctionRef -> CString -> IO ()
Raw.setValueName

dumpValue :: ValueRef -> IO ()
dumpValue :: FunctionRef -> IO ()
dumpValue = FunctionRef -> IO ()
Raw.dumpValue

replaceAllUsesWith :: ValueRef -> ValueRef -> IO ()
replaceAllUsesWith :: FunctionRef -> FunctionRef -> IO ()
replaceAllUsesWith = FunctionRef -> FunctionRef -> IO ()
Raw.replaceAllUsesWith

hasMetadata :: ValueRef -> IO LLVM.Bool
hasMetadata :: FunctionRef -> IO Bool
hasMetadata = (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> Bool
LLVM.Bool (Int32 -> Bool) -> (CInt -> Int32) -> CInt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO Bool)
-> (FunctionRef -> IO CInt) -> FunctionRef -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionRef -> IO CInt
Raw.hasMetadata

getMetadata :: ValueRef -> CUInt -> IO ValueRef
getMetadata :: FunctionRef -> CUInt -> IO FunctionRef
getMetadata = FunctionRef -> CUInt -> IO FunctionRef
Raw.getMetadata

setMetadata :: ValueRef -> CUInt -> ValueRef -> IO ()
setMetadata :: FunctionRef -> CUInt -> FunctionRef -> IO ()
setMetadata = FunctionRef -> CUInt -> FunctionRef -> IO ()
Raw.setMetadata


-- ** Uses
getFirstUse :: ValueRef -> IO UseRef
getFirstUse :: FunctionRef -> IO UseRef
getFirstUse = FunctionRef -> IO UseRef
Raw.getFirstUse

getNextUse :: UseRef -> IO UseRef
getNextUse :: UseRef -> IO UseRef
getNextUse = UseRef -> IO UseRef
Raw.getNextUse

getUser :: UseRef -> IO ValueRef
getUser :: UseRef -> IO FunctionRef
getUser = UseRef -> IO FunctionRef
Raw.getUser

getUsedValue :: UseRef -> IO ValueRef
getUsedValue :: UseRef -> IO FunctionRef
getUsedValue = UseRef -> IO FunctionRef
Raw.getUsedValue


-- ** Users
getOperand :: ValueRef -> CUInt -> IO ValueRef
getOperand :: FunctionRef -> CUInt -> IO FunctionRef
getOperand = FunctionRef -> CUInt -> IO FunctionRef
Raw.getOperand

setOperand :: ValueRef -> CUInt -> ValueRef -> IO ()
setOperand :: FunctionRef -> CUInt -> FunctionRef -> IO ()
setOperand = FunctionRef -> CUInt -> FunctionRef -> IO ()
Raw.setOperand

getNumOperands :: ValueRef -> IO CUInt
getNumOperands :: FunctionRef -> IO CUInt
getNumOperands = (CInt -> CUInt) -> IO CInt -> IO CUInt
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO CUInt)
-> (FunctionRef -> IO CInt) -> FunctionRef -> IO CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionRef -> IO CInt
Raw.getNumOperands


-- ** Constants
constNull :: TypeRef -> IO ValueRef
constNull :: TypeRef -> IO FunctionRef
constNull = TypeRef -> IO FunctionRef
Raw.constNull

constAllOnes :: TypeRef -> IO ValueRef
constAllOnes :: TypeRef -> IO FunctionRef
constAllOnes = TypeRef -> IO FunctionRef
Raw.constAllOnes

getUndef :: TypeRef -> IO ValueRef
getUndef :: TypeRef -> IO FunctionRef
getUndef = TypeRef -> IO FunctionRef
Raw.getUndef

isConstant :: ValueRef -> IO LLVM.Bool
isConstant :: FunctionRef -> IO Bool
isConstant = FunctionRef -> IO Bool
Raw.isConstant

isUndef :: ValueRef -> IO LLVM.Bool
isUndef :: FunctionRef -> IO Bool
isUndef = FunctionRef -> IO Bool
Raw.isUndef

isNull :: ValueRef -> IO LLVM.Bool
isNull :: FunctionRef -> IO Bool
isNull = FunctionRef -> IO Bool
Raw.isNull

constPointerNull :: TypeRef -> IO ValueRef
constPointerNull :: TypeRef -> IO FunctionRef
constPointerNull = TypeRef -> IO FunctionRef
Raw.constPointerNull


-- ** Metadata
mDStringInContext :: ContextRef -> CString -> CUInt -> IO ValueRef
mDStringInContext :: ContextRef -> CString -> CUInt -> IO FunctionRef
mDStringInContext = ContextRef -> CString -> CUInt -> IO FunctionRef
Raw.mDStringInContext

mDString :: CString -> CUInt -> IO ValueRef
mDString :: CString -> CUInt -> IO FunctionRef
mDString = CString -> CUInt -> IO FunctionRef
Raw.mDString

mDNodeInContext :: ContextRef -> Ptr ValueRef -> CUInt -> IO ValueRef
mDNodeInContext :: ContextRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
mDNodeInContext = ContextRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.mDNodeInContext

mDNode :: Ptr ValueRef -> CUInt -> IO ValueRef
mDNode :: Ptr FunctionRef -> CUInt -> IO FunctionRef
mDNode = Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.mDNode

getMDString :: ValueRef -> Ptr CUInt -> IO CString
getMDString :: FunctionRef -> Ptr CUInt -> IO CString
getMDString = FunctionRef -> Ptr CUInt -> IO CString
Raw.getMDString

getNamedMetadataNumOperands :: ModuleRef -> CString -> IO CUInt
getNamedMetadataNumOperands :: ModuleRef -> CString -> IO CUInt
getNamedMetadataNumOperands = ModuleRef -> CString -> IO CUInt
Raw.getNamedMetadataNumOperands

getNamedMetadataOperands :: ModuleRef -> CString -> Ptr ValueRef -> IO ()
getNamedMetadataOperands :: ModuleRef -> CString -> Ptr FunctionRef -> IO ()
getNamedMetadataOperands = ModuleRef -> CString -> Ptr FunctionRef -> IO ()
Raw.getNamedMetadataOperands


-- ** Scalar Constants
constInt :: TypeRef -> CULLong -> LLVM.Bool -> IO ValueRef
constInt :: TypeRef -> CULLong -> Bool -> IO FunctionRef
constInt = TypeRef -> CULLong -> Bool -> IO FunctionRef
Raw.constInt

constIntOfArbitraryPrecision :: TypeRef -> CUInt -> Ptr Word64 -> IO ValueRef
constIntOfArbitraryPrecision :: TypeRef -> CUInt -> Ptr Word64 -> IO FunctionRef
constIntOfArbitraryPrecision = TypeRef -> CUInt -> Ptr Word64 -> IO FunctionRef
Raw.constIntOfArbitraryPrecision

constIntOfString :: TypeRef -> CString -> Word8 -> IO ValueRef
constIntOfString :: TypeRef -> CString -> Word8 -> IO FunctionRef
constIntOfString = TypeRef -> CString -> Word8 -> IO FunctionRef
Raw.constIntOfString

constIntOfStringAndSize :: TypeRef -> CString -> CUInt -> Word8 -> IO ValueRef
constIntOfStringAndSize :: TypeRef -> CString -> CUInt -> Word8 -> IO FunctionRef
constIntOfStringAndSize = TypeRef -> CString -> CUInt -> Word8 -> IO FunctionRef
Raw.constIntOfStringAndSize

constReal :: TypeRef -> CDouble -> IO ValueRef
constReal :: TypeRef -> CDouble -> IO FunctionRef
constReal = TypeRef -> CDouble -> IO FunctionRef
Raw.constReal

constRealOfString :: TypeRef -> CString -> IO ValueRef
constRealOfString :: TypeRef -> CString -> IO FunctionRef
constRealOfString = TypeRef -> CString -> IO FunctionRef
Raw.constRealOfString

constRealOfStringAndSize :: TypeRef -> CString -> CUInt -> IO ValueRef
constRealOfStringAndSize :: TypeRef -> CString -> CUInt -> IO FunctionRef
constRealOfStringAndSize = TypeRef -> CString -> CUInt -> IO FunctionRef
Raw.constRealOfStringAndSize

constIntGetZExtValue :: ValueRef -> IO CULLong
constIntGetZExtValue :: FunctionRef -> IO CULLong
constIntGetZExtValue = FunctionRef -> IO CULLong
Raw.constIntGetZExtValue

constIntGetSExtValue :: ValueRef -> IO CLLong
constIntGetSExtValue :: FunctionRef -> IO CLLong
constIntGetSExtValue = FunctionRef -> IO CLLong
Raw.constIntGetSExtValue


-- ** Composite Constants
constStringInContext :: ContextRef -> CString -> CUInt -> LLVM.Bool -> IO ValueRef
constStringInContext :: ContextRef -> CString -> CUInt -> Bool -> IO FunctionRef
constStringInContext = ContextRef -> CString -> CUInt -> Bool -> IO FunctionRef
Raw.constStringInContext

constStructInContext :: ContextRef -> Ptr ValueRef -> CUInt -> LLVM.Bool -> IO ValueRef
constStructInContext :: ContextRef -> Ptr FunctionRef -> CUInt -> Bool -> IO FunctionRef
constStructInContext = ContextRef -> Ptr FunctionRef -> CUInt -> Bool -> IO FunctionRef
Raw.constStructInContext

constString :: CString -> CUInt -> LLVM.Bool -> IO ValueRef
constString :: CString -> CUInt -> Bool -> IO FunctionRef
constString = CString -> CUInt -> Bool -> IO FunctionRef
Raw.constString

constArray :: TypeRef -> Ptr ValueRef -> CUInt -> IO ValueRef
constArray :: TypeRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
constArray = TypeRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.constArray

constStruct :: Ptr ValueRef -> CUInt -> LLVM.Bool -> IO ValueRef
constStruct :: Ptr FunctionRef -> CUInt -> Bool -> IO FunctionRef
constStruct = Ptr FunctionRef -> CUInt -> Bool -> IO FunctionRef
Raw.constStruct

constNamedStruct :: TypeRef -> Ptr ValueRef -> CUInt -> IO ValueRef
constNamedStruct :: TypeRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
constNamedStruct = TypeRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.constNamedStruct

constVector :: Ptr ValueRef -> CUInt -> IO ValueRef
constVector :: Ptr FunctionRef -> CUInt -> IO FunctionRef
constVector = Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.constVector


-- ** Constant expressions
getConstOpcode :: ValueRef -> IO Raw.Opcode
getConstOpcode :: FunctionRef -> IO Opcode
getConstOpcode = FunctionRef -> IO Opcode
Raw.getConstOpcode

alignOf :: TypeRef -> IO ValueRef
alignOf :: TypeRef -> IO FunctionRef
alignOf = TypeRef -> IO FunctionRef
Raw.alignOf

sizeOf :: TypeRef -> IO ValueRef
sizeOf :: TypeRef -> IO FunctionRef
sizeOf = TypeRef -> IO FunctionRef
Raw.sizeOf

constNeg :: ValueRef -> IO ValueRef
constNeg :: FunctionRef -> IO FunctionRef
constNeg = FunctionRef -> IO FunctionRef
Raw.constNeg

constNSWNeg :: ValueRef -> IO ValueRef
constNSWNeg :: FunctionRef -> IO FunctionRef
constNSWNeg = FunctionRef -> IO FunctionRef
Raw.constNSWNeg

constNot :: ValueRef -> IO ValueRef
constNot :: FunctionRef -> IO FunctionRef
constNot = FunctionRef -> IO FunctionRef
Raw.constNot

constAdd :: ValueRef -> ValueRef -> IO ValueRef
constAdd :: FunctionRef -> FunctionRef -> IO FunctionRef
constAdd = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constAdd

constNSWAdd :: ValueRef -> ValueRef -> IO ValueRef
constNSWAdd :: FunctionRef -> FunctionRef -> IO FunctionRef
constNSWAdd = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNSWAdd

constNUWAdd :: ValueRef -> ValueRef -> IO ValueRef
constNUWAdd :: FunctionRef -> FunctionRef -> IO FunctionRef
constNUWAdd = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNUWAdd

constSub :: ValueRef -> ValueRef -> IO ValueRef
constSub :: FunctionRef -> FunctionRef -> IO FunctionRef
constSub = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constSub

constNSWSub :: ValueRef -> ValueRef -> IO ValueRef
constNSWSub :: FunctionRef -> FunctionRef -> IO FunctionRef
constNSWSub = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNSWSub

constNUWSub :: ValueRef -> ValueRef -> IO ValueRef
constNUWSub :: FunctionRef -> FunctionRef -> IO FunctionRef
constNUWSub = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNUWSub

constMul :: ValueRef -> ValueRef -> IO ValueRef
constMul :: FunctionRef -> FunctionRef -> IO FunctionRef
constMul = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constMul

constNSWMul :: ValueRef -> ValueRef -> IO ValueRef
constNSWMul :: FunctionRef -> FunctionRef -> IO FunctionRef
constNSWMul = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNSWMul

constNUWMul :: ValueRef -> ValueRef -> IO ValueRef
constNUWMul :: FunctionRef -> FunctionRef -> IO FunctionRef
constNUWMul = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constNUWMul

constXor :: ValueRef -> ValueRef -> IO ValueRef
constXor :: FunctionRef -> FunctionRef -> IO FunctionRef
constXor = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constXor

constGEP2 :: TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> IO ValueRef
constGEP2 :: TypeRef
-> FunctionRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
constGEP2 = TypeRef
-> FunctionRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Core14.constGEP2

constInBoundsGEP2 :: TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> IO ValueRef
constInBoundsGEP2 :: TypeRef
-> FunctionRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
constInBoundsGEP2 = TypeRef
-> FunctionRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Core14.constInBoundsGEP2

constTrunc :: ValueRef -> TypeRef -> IO ValueRef
constTrunc :: FunctionRef -> TypeRef -> IO FunctionRef
constTrunc = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constTrunc

constPtrToInt :: ValueRef -> TypeRef -> IO ValueRef
constPtrToInt :: FunctionRef -> TypeRef -> IO FunctionRef
constPtrToInt = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constPtrToInt

constIntToPtr :: ValueRef -> TypeRef -> IO ValueRef
constIntToPtr :: FunctionRef -> TypeRef -> IO FunctionRef
constIntToPtr = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constIntToPtr

constBitCast :: ValueRef -> TypeRef -> IO ValueRef
constBitCast :: FunctionRef -> TypeRef -> IO FunctionRef
constBitCast = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constBitCast

constTruncOrBitCast :: ValueRef -> TypeRef -> IO ValueRef
constTruncOrBitCast :: FunctionRef -> TypeRef -> IO FunctionRef
constTruncOrBitCast = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constTruncOrBitCast

constPointerCast :: ValueRef -> TypeRef -> IO ValueRef
constPointerCast :: FunctionRef -> TypeRef -> IO FunctionRef
constPointerCast = FunctionRef -> TypeRef -> IO FunctionRef
Raw.constPointerCast

constExtractElement :: ValueRef -> ValueRef -> IO ValueRef
constExtractElement :: FunctionRef -> FunctionRef -> IO FunctionRef
constExtractElement = FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constExtractElement

constInsertElement :: ValueRef -> ValueRef -> ValueRef -> IO ValueRef
constInsertElement :: FunctionRef -> FunctionRef -> FunctionRef -> IO FunctionRef
constInsertElement = FunctionRef -> FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constInsertElement

constShuffleVector :: ValueRef -> ValueRef -> ValueRef -> IO ValueRef
constShuffleVector :: FunctionRef -> FunctionRef -> FunctionRef -> IO FunctionRef
constShuffleVector = FunctionRef -> FunctionRef -> FunctionRef -> IO FunctionRef
Raw.constShuffleVector

constInlineAsm :: TypeRef -> CString -> CString -> LLVM.Bool -> LLVM.Bool -> IO ValueRef
constInlineAsm :: TypeRef -> CString -> CString -> Bool -> Bool -> IO FunctionRef
constInlineAsm = TypeRef -> CString -> CString -> Bool -> Bool -> IO FunctionRef
Raw.constInlineAsm

blockAddress :: ValueRef -> BasicBlockRef -> IO ValueRef
blockAddress :: FunctionRef -> BasicBlockRef -> IO FunctionRef
blockAddress = FunctionRef -> BasicBlockRef -> IO FunctionRef
Raw.blockAddress


-- ** Operations on globals
getGlobalParent :: ValueRef -> IO ModuleRef
getGlobalParent :: FunctionRef -> IO ModuleRef
getGlobalParent = FunctionRef -> IO ModuleRef
Raw.getGlobalParent

isDeclaration :: ValueRef -> IO LLVM.Bool
isDeclaration :: FunctionRef -> IO Bool
isDeclaration = FunctionRef -> IO Bool
Raw.isDeclaration

getLinkage :: ValueRef -> IO Raw.Linkage
getLinkage :: FunctionRef -> IO Linkage
getLinkage = FunctionRef -> IO Linkage
Raw.getLinkage

setLinkage :: ValueRef -> Raw.Linkage -> IO ()
setLinkage :: FunctionRef -> Linkage -> IO ()
setLinkage = FunctionRef -> Linkage -> IO ()
Raw.setLinkage

getSection :: ValueRef -> IO CString
getSection :: FunctionRef -> IO CString
getSection = FunctionRef -> IO CString
Raw.getSection

setSection :: ValueRef -> CString -> IO ()
setSection :: FunctionRef -> CString -> IO ()
setSection = FunctionRef -> CString -> IO ()
Raw.setSection

getVisibility :: ValueRef -> IO Raw.Visibility
getVisibility :: FunctionRef -> IO Visibility
getVisibility = FunctionRef -> IO Visibility
Raw.getVisibility

setVisibility :: ValueRef -> Raw.Visibility -> IO ()
setVisibility :: FunctionRef -> Visibility -> IO ()
setVisibility = FunctionRef -> Visibility -> IO ()
Raw.setVisibility

getAlignment :: ValueRef -> IO CUInt
getAlignment :: FunctionRef -> IO CUInt
getAlignment = FunctionRef -> IO CUInt
Raw.getAlignment

setAlignment :: ValueRef -> CUInt -> IO ()
setAlignment :: FunctionRef -> CUInt -> IO ()
setAlignment = FunctionRef -> CUInt -> IO ()
Raw.setAlignment


-- ** Global Variables
addGlobal :: ModuleRef -> TypeRef -> CString -> IO ValueRef
addGlobal :: ModuleRef -> TypeRef -> CString -> IO FunctionRef
addGlobal = ModuleRef -> TypeRef -> CString -> IO FunctionRef
Raw.addGlobal

addGlobalInAddressSpace :: ModuleRef -> TypeRef -> CString -> CUInt -> IO ValueRef
addGlobalInAddressSpace :: ModuleRef -> TypeRef -> CString -> CUInt -> IO FunctionRef
addGlobalInAddressSpace = ModuleRef -> TypeRef -> CString -> CUInt -> IO FunctionRef
Raw.addGlobalInAddressSpace

getNamedGlobal :: ModuleRef -> CString -> IO ValueRef
getNamedGlobal :: ModuleRef -> CString -> IO FunctionRef
getNamedGlobal = ModuleRef -> CString -> IO FunctionRef
Raw.getNamedGlobal

getFirstGlobal :: ModuleRef -> IO ValueRef
getFirstGlobal :: ModuleRef -> IO FunctionRef
getFirstGlobal = ModuleRef -> IO FunctionRef
Raw.getFirstGlobal

getLastGlobal :: ModuleRef -> IO ValueRef
getLastGlobal :: ModuleRef -> IO FunctionRef
getLastGlobal = ModuleRef -> IO FunctionRef
Raw.getLastGlobal

getNextGlobal :: ValueRef -> IO ValueRef
getNextGlobal :: FunctionRef -> IO FunctionRef
getNextGlobal = FunctionRef -> IO FunctionRef
Raw.getNextGlobal

getPreviousGlobal :: ValueRef -> IO ValueRef
getPreviousGlobal :: FunctionRef -> IO FunctionRef
getPreviousGlobal = FunctionRef -> IO FunctionRef
Raw.getPreviousGlobal

deleteGlobal :: ValueRef -> IO ()
deleteGlobal :: FunctionRef -> IO ()
deleteGlobal = FunctionRef -> IO ()
Raw.deleteGlobal

setInitializer :: ValueRef -> ValueRef -> IO ()
setInitializer :: FunctionRef -> FunctionRef -> IO ()
setInitializer = FunctionRef -> FunctionRef -> IO ()
Raw.setInitializer

getInitializer :: ValueRef -> IO ValueRef
getInitializer :: FunctionRef -> IO FunctionRef
getInitializer = FunctionRef -> IO FunctionRef
Raw.getInitializer

isThreadLocal :: ValueRef -> IO LLVM.Bool
isThreadLocal :: FunctionRef -> IO Bool
isThreadLocal = FunctionRef -> IO Bool
Raw.isThreadLocal

setThreadLocal :: ValueRef -> LLVM.Bool -> IO ()
setThreadLocal :: FunctionRef -> Bool -> IO ()
setThreadLocal = FunctionRef -> Bool -> IO ()
Raw.setThreadLocal

isGlobalConstant :: ValueRef -> IO LLVM.Bool
isGlobalConstant :: FunctionRef -> IO Bool
isGlobalConstant = FunctionRef -> IO Bool
Raw.isGlobalConstant

setGlobalConstant :: ValueRef -> LLVM.Bool -> IO ()
setGlobalConstant :: FunctionRef -> Bool -> IO ()
setGlobalConstant = FunctionRef -> Bool -> IO ()
Raw.setGlobalConstant


-- ** Aliases
addAlias2 :: ModuleRef -> TypeRef -> CUInt -> ValueRef -> CString -> IO ValueRef
addAlias2 :: ModuleRef
-> TypeRef -> CUInt -> FunctionRef -> CString -> IO FunctionRef
addAlias2 = ModuleRef
-> TypeRef -> CUInt -> FunctionRef -> CString -> IO FunctionRef
Core14.addAlias2

deleteFunction :: FunctionRef -> IO ()
deleteFunction :: FunctionRef -> IO ()
deleteFunction = FunctionRef -> IO ()
Raw.deleteFunction

getIntrinsicID :: FunctionRef -> IO CUInt
getIntrinsicID :: FunctionRef -> IO CUInt
getIntrinsicID = FunctionRef -> IO CUInt
Raw.getIntrinsicID

getFunctionCallConv :: FunctionRef -> IO Raw.CallingConvention
getFunctionCallConv :: FunctionRef -> IO CallingConvention
getFunctionCallConv = (CUInt -> CallingConvention) -> IO CUInt -> IO CallingConvention
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> CallingConvention
Raw.CallingConvention (IO CUInt -> IO CallingConvention)
-> (FunctionRef -> IO CUInt) -> FunctionRef -> IO CallingConvention
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionRef -> IO CUInt
Raw.getFunctionCallConv

setFunctionCallConv :: FunctionRef -> Raw.CallingConvention -> IO ()
setFunctionCallConv :: FunctionRef -> CallingConvention -> IO ()
setFunctionCallConv FunctionRef
f = FunctionRef -> CUInt -> IO ()
Raw.setFunctionCallConv FunctionRef
f (CUInt -> IO ())
-> (CallingConvention -> CUInt) -> CallingConvention -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallingConvention -> CUInt
Raw.unCallingConvention

getGC :: ValueRef -> IO CString
getGC :: FunctionRef -> IO CString
getGC = FunctionRef -> IO CString
Raw.getGC

setGC :: ValueRef -> CString -> IO ()
setGC :: FunctionRef -> CString -> IO ()
setGC = FunctionRef -> CString -> IO ()
Raw.setGC


-- ** Raw.Attribute attachment

addAttributeAtIndex :: ValueRef -> AttributeIndex -> AttributeRef -> IO ()
addAttributeAtIndex :: FunctionRef -> AttributeIndex -> AttributeRef -> IO ()
addAttributeAtIndex = FunctionRef -> AttributeIndex -> AttributeRef -> IO ()
Raw.addAttributeAtIndex

getAttributeCountAtIndex :: ValueRef -> AttributeIndex -> IO CUInt
getAttributeCountAtIndex :: FunctionRef -> AttributeIndex -> IO CUInt
getAttributeCountAtIndex = FunctionRef -> AttributeIndex -> IO CUInt
Raw.getAttributeCountAtIndex

getAttributesAtIndex :: ValueRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
getAttributesAtIndex :: FunctionRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
getAttributesAtIndex = FunctionRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
Raw.getAttributesAtIndex

getEnumAttributeAtIndex :: ValueRef -> AttributeIndex -> AttributeKind -> IO AttributeRef
getEnumAttributeAtIndex :: FunctionRef -> AttributeIndex -> AttributeKind -> IO AttributeRef
getEnumAttributeAtIndex FunctionRef
v AttributeIndex
i (AttributeKind CUInt
kindId) = FunctionRef -> AttributeIndex -> CUInt -> IO AttributeRef
Raw.getEnumAttributeAtIndex FunctionRef
v AttributeIndex
i CUInt
kindId

getStringAttributeAtIndex :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO AttributeRef
getStringAttributeAtIndex :: FunctionRef
-> AttributeIndex -> CString -> CUInt -> IO AttributeRef
getStringAttributeAtIndex = FunctionRef
-> AttributeIndex -> CString -> CUInt -> IO AttributeRef
Raw.getStringAttributeAtIndex

removeEnumAttributeAtIndex :: ValueRef -> AttributeIndex -> AttributeKind -> IO ()
removeEnumAttributeAtIndex :: FunctionRef -> AttributeIndex -> AttributeKind -> IO ()
removeEnumAttributeAtIndex FunctionRef
v AttributeIndex
i (AttributeKind CUInt
kindId) = FunctionRef -> AttributeIndex -> CUInt -> IO ()
Raw.removeEnumAttributeAtIndex FunctionRef
v AttributeIndex
i CUInt
kindId

removeStringAttributeAtIndex :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO ()
removeStringAttributeAtIndex :: FunctionRef -> AttributeIndex -> CString -> CUInt -> IO ()
removeStringAttributeAtIndex = FunctionRef -> AttributeIndex -> CString -> CUInt -> IO ()
Raw.removeStringAttributeAtIndex

addTargetDependentFunctionAttr :: ValueRef -> CString -> CString -> IO ()
addTargetDependentFunctionAttr :: FunctionRef -> CString -> CString -> IO ()
addTargetDependentFunctionAttr = FunctionRef -> CString -> CString -> IO ()
Raw.addTargetDependentFunctionAttr


-- ** Parameters
countParams :: FunctionRef -> IO CUInt
countParams :: FunctionRef -> IO CUInt
countParams = FunctionRef -> IO CUInt
Raw.countParams

getParams
    :: FunctionRef
    -> Ptr ValueRef             -- ^ array to fill out
    -> IO ()
getParams :: FunctionRef -> Ptr FunctionRef -> IO ()
getParams = FunctionRef -> Ptr FunctionRef -> IO ()
Raw.getParams

getParam
    :: FunctionRef
    -> CUInt                    -- ^ offset into array
    -> IO ValueRef
getParam :: FunctionRef -> CUInt -> IO FunctionRef
getParam = FunctionRef -> CUInt -> IO FunctionRef
Raw.getParam

getParamParent :: ValueRef -> IO ValueRef
getParamParent :: FunctionRef -> IO FunctionRef
getParamParent = FunctionRef -> IO FunctionRef
Raw.getParamParent

getFirstParam :: ValueRef -> IO ValueRef
getFirstParam :: FunctionRef -> IO FunctionRef
getFirstParam = FunctionRef -> IO FunctionRef
Raw.getFirstParam

getLastParam :: ValueRef -> IO ValueRef
getLastParam :: FunctionRef -> IO FunctionRef
getLastParam = FunctionRef -> IO FunctionRef
Raw.getLastParam

getNextParam :: ValueRef -> IO ValueRef
getNextParam :: FunctionRef -> IO FunctionRef
getNextParam = FunctionRef -> IO FunctionRef
Raw.getNextParam

getPreviousParam :: ValueRef -> IO ValueRef
getPreviousParam :: FunctionRef -> IO FunctionRef
getPreviousParam = FunctionRef -> IO FunctionRef
Raw.getPreviousParam

setParamAlignment :: ValueRef -> CUInt -> IO ()
setParamAlignment :: FunctionRef -> CUInt -> IO ()
setParamAlignment = FunctionRef -> CUInt -> IO ()
Raw.setParamAlignment


-- ** Basic Blocks
basicBlockAsValue :: BasicBlockRef -> IO ValueRef
basicBlockAsValue :: BasicBlockRef -> IO FunctionRef
basicBlockAsValue = BasicBlockRef -> IO FunctionRef
Raw.basicBlockAsValue

valueIsBasicBlock :: ValueRef -> IO LLVM.Bool
valueIsBasicBlock :: FunctionRef -> IO Bool
valueIsBasicBlock = FunctionRef -> IO Bool
Raw.valueIsBasicBlock

valueAsBasicBlock
    :: ValueRef                 -- ^ basic block
    -> IO BasicBlockRef
valueAsBasicBlock :: FunctionRef -> IO BasicBlockRef
valueAsBasicBlock = FunctionRef -> IO BasicBlockRef
Raw.valueAsBasicBlock

getBasicBlockName :: BasicBlockRef -> IO CString
getBasicBlockName :: BasicBlockRef -> IO CString
getBasicBlockName = BasicBlockRef -> IO CString
Raw.getBasicBlockName

getBasicBlockParent :: BasicBlockRef -> IO ValueRef
getBasicBlockParent :: BasicBlockRef -> IO FunctionRef
getBasicBlockParent = BasicBlockRef -> IO FunctionRef
Raw.getBasicBlockParent

getBasicBlockTerminator :: BasicBlockRef -> IO ValueRef
getBasicBlockTerminator :: BasicBlockRef -> IO FunctionRef
getBasicBlockTerminator = BasicBlockRef -> IO FunctionRef
Raw.getBasicBlockTerminator

countBasicBlocks
    :: ValueRef                 -- ^ function
    -> IO CUInt
countBasicBlocks :: FunctionRef -> IO CUInt
countBasicBlocks = FunctionRef -> IO CUInt
Raw.countBasicBlocks

getBasicBlocks
    :: ValueRef                 -- ^ function
    -> Ptr BasicBlockRef        -- ^ array to fill out
    -> IO ()
getBasicBlocks :: FunctionRef -> Ptr BasicBlockRef -> IO ()
getBasicBlocks = FunctionRef -> Ptr BasicBlockRef -> IO ()
Raw.getBasicBlocks

getFirstBasicBlock :: ValueRef -> IO BasicBlockRef
getFirstBasicBlock :: FunctionRef -> IO BasicBlockRef
getFirstBasicBlock = FunctionRef -> IO BasicBlockRef
Raw.getFirstBasicBlock

getLastBasicBlock :: ValueRef -> IO BasicBlockRef
getLastBasicBlock :: FunctionRef -> IO BasicBlockRef
getLastBasicBlock = FunctionRef -> IO BasicBlockRef
Raw.getLastBasicBlock

getNextBasicBlock :: BasicBlockRef -> IO BasicBlockRef
getNextBasicBlock :: BasicBlockRef -> IO BasicBlockRef
getNextBasicBlock = BasicBlockRef -> IO BasicBlockRef
Raw.getNextBasicBlock

getPreviousBasicBlock :: BasicBlockRef -> IO BasicBlockRef
getPreviousBasicBlock :: BasicBlockRef -> IO BasicBlockRef
getPreviousBasicBlock = BasicBlockRef -> IO BasicBlockRef
Raw.getPreviousBasicBlock

getEntryBasicBlock
    :: ValueRef                 -- ^ function
    -> IO BasicBlockRef
getEntryBasicBlock :: FunctionRef -> IO BasicBlockRef
getEntryBasicBlock = FunctionRef -> IO BasicBlockRef
Raw.getEntryBasicBlock

appendBasicBlockInContext :: ContextRef -> ValueRef -> CString -> IO BasicBlockRef
appendBasicBlockInContext :: ContextRef -> FunctionRef -> CString -> IO BasicBlockRef
appendBasicBlockInContext = ContextRef -> FunctionRef -> CString -> IO BasicBlockRef
Raw.appendBasicBlockInContext

insertBasicBlockInContext :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef
insertBasicBlockInContext :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef
insertBasicBlockInContext = ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef
Raw.insertBasicBlockInContext

appendBasicBlock
    :: ValueRef                 -- ^ function
    -> CString                  -- ^ name for label
    -> IO BasicBlockRef
appendBasicBlock :: FunctionRef -> CString -> IO BasicBlockRef
appendBasicBlock = FunctionRef -> CString -> IO BasicBlockRef
Raw.appendBasicBlock

insertBasicBlock
    :: BasicBlockRef            -- ^ insert before this one
    -> CString                  -- ^ name for label
    -> IO BasicBlockRef
insertBasicBlock :: BasicBlockRef -> CString -> IO BasicBlockRef
insertBasicBlock = BasicBlockRef -> CString -> IO BasicBlockRef
Raw.insertBasicBlock

deleteBasicBlock :: BasicBlockRef -> IO ()
deleteBasicBlock :: BasicBlockRef -> IO ()
deleteBasicBlock = BasicBlockRef -> IO ()
Raw.deleteBasicBlock

removeBasicBlockFromParent :: BasicBlockRef -> IO ()
removeBasicBlockFromParent :: BasicBlockRef -> IO ()
removeBasicBlockFromParent = BasicBlockRef -> IO ()
Raw.removeBasicBlockFromParent

moveBasicBlockBefore :: BasicBlockRef -> BasicBlockRef -> IO ()
moveBasicBlockBefore :: BasicBlockRef -> BasicBlockRef -> IO ()
moveBasicBlockBefore = BasicBlockRef -> BasicBlockRef -> IO ()
Raw.moveBasicBlockBefore

moveBasicBlockAfter :: BasicBlockRef -> BasicBlockRef -> IO ()
moveBasicBlockAfter :: BasicBlockRef -> BasicBlockRef -> IO ()
moveBasicBlockAfter = BasicBlockRef -> BasicBlockRef -> IO ()
Raw.moveBasicBlockAfter

getFirstInstruction :: BasicBlockRef -> IO ValueRef
getFirstInstruction :: BasicBlockRef -> IO FunctionRef
getFirstInstruction = BasicBlockRef -> IO FunctionRef
Raw.getFirstInstruction

getLastInstruction :: BasicBlockRef -> IO ValueRef
getLastInstruction :: BasicBlockRef -> IO FunctionRef
getLastInstruction = BasicBlockRef -> IO FunctionRef
Raw.getLastInstruction


-- ** Instructions
getInstructionParent :: ValueRef -> IO BasicBlockRef
getInstructionParent :: FunctionRef -> IO BasicBlockRef
getInstructionParent = FunctionRef -> IO BasicBlockRef
Raw.getInstructionParent

getNextInstruction :: ValueRef -> IO ValueRef
getNextInstruction :: FunctionRef -> IO FunctionRef
getNextInstruction = FunctionRef -> IO FunctionRef
Raw.getNextInstruction

getPreviousInstruction :: ValueRef -> IO ValueRef
getPreviousInstruction :: FunctionRef -> IO FunctionRef
getPreviousInstruction = FunctionRef -> IO FunctionRef
Raw.getPreviousInstruction

instructionEraseFromParent :: ValueRef -> IO ()
instructionEraseFromParent :: FunctionRef -> IO ()
instructionEraseFromParent = FunctionRef -> IO ()
Raw.instructionEraseFromParent

getInstructionOpcode :: ValueRef -> IO Raw.Opcode
getInstructionOpcode :: FunctionRef -> IO Opcode
getInstructionOpcode = FunctionRef -> IO Opcode
Raw.getInstructionOpcode

getICmpPredicate :: ValueRef -> IO Raw.IntPredicate
getICmpPredicate :: FunctionRef -> IO IntPredicate
getICmpPredicate = FunctionRef -> IO IntPredicate
Raw.getICmpPredicate


-- ** Call sites
setInstructionCallConv :: ValueRef -> Raw.CallingConvention -> IO ()
setInstructionCallConv :: FunctionRef -> CallingConvention -> IO ()
setInstructionCallConv FunctionRef
v =
   FunctionRef -> CUInt -> IO ()
Raw.setInstructionCallConv FunctionRef
v (CUInt -> IO ())
-> (CallingConvention -> CUInt) -> CallingConvention -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallingConvention -> CUInt
Raw.unCallingConvention

getInstructionCallConv :: ValueRef -> IO Raw.CallingConvention
getInstructionCallConv :: FunctionRef -> IO CallingConvention
getInstructionCallConv =
   (CUInt -> CallingConvention) -> IO CUInt -> IO CallingConvention
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> CallingConvention
Raw.CallingConvention (IO CUInt -> IO CallingConvention)
-> (FunctionRef -> IO CUInt) -> FunctionRef -> IO CallingConvention
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionRef -> IO CUInt
Raw.getInstructionCallConv

setInstrParamAlignment :: ValueRef -> AttributeIndex -> CUInt -> IO ()
setInstrParamAlignment :: FunctionRef -> AttributeIndex -> CUInt -> IO ()
setInstrParamAlignment = FunctionRef -> AttributeIndex -> CUInt -> IO ()
Raw.setInstrParamAlignment


addCallSiteAttribute :: ValueRef -> AttributeIndex -> AttributeRef -> IO ()
addCallSiteAttribute :: FunctionRef -> AttributeIndex -> AttributeRef -> IO ()
addCallSiteAttribute = FunctionRef -> AttributeIndex -> AttributeRef -> IO ()
Raw.addCallSiteAttribute

getCallSiteAttributeCount :: ValueRef -> AttributeIndex -> IO CUInt
getCallSiteAttributeCount :: FunctionRef -> AttributeIndex -> IO CUInt
getCallSiteAttributeCount = FunctionRef -> AttributeIndex -> IO CUInt
Raw.getCallSiteAttributeCount

getCallSiteAttributes :: ValueRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
getCallSiteAttributes :: FunctionRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
getCallSiteAttributes = FunctionRef -> AttributeIndex -> Ptr AttributeRef -> IO ()
Raw.getCallSiteAttributes

getCallSiteEnumAttribute :: ValueRef -> AttributeIndex -> AttributeKind -> IO AttributeRef
getCallSiteEnumAttribute :: FunctionRef -> AttributeIndex -> AttributeKind -> IO AttributeRef
getCallSiteEnumAttribute FunctionRef
v AttributeIndex
i (AttributeKind CUInt
kindId) = FunctionRef -> AttributeIndex -> CUInt -> IO AttributeRef
Raw.getCallSiteEnumAttribute FunctionRef
v AttributeIndex
i CUInt
kindId

getCallSiteStringAttribute :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO AttributeRef
getCallSiteStringAttribute :: FunctionRef
-> AttributeIndex -> CString -> CUInt -> IO AttributeRef
getCallSiteStringAttribute = FunctionRef
-> AttributeIndex -> CString -> CUInt -> IO AttributeRef
Raw.getCallSiteStringAttribute

removeCallSiteEnumAttribute :: ValueRef -> AttributeIndex -> AttributeKind -> IO ()
removeCallSiteEnumAttribute :: FunctionRef -> AttributeIndex -> AttributeKind -> IO ()
removeCallSiteEnumAttribute FunctionRef
v AttributeIndex
i (AttributeKind CUInt
kindId) = FunctionRef -> AttributeIndex -> CUInt -> IO ()
Raw.removeCallSiteEnumAttribute FunctionRef
v AttributeIndex
i CUInt
kindId

removeCallSiteStringAttribute :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO ()
removeCallSiteStringAttribute :: FunctionRef -> AttributeIndex -> CString -> CUInt -> IO ()
removeCallSiteStringAttribute = FunctionRef -> AttributeIndex -> CString -> CUInt -> IO ()
Raw.removeCallSiteStringAttribute

getCalledValue :: ValueRef -> IO ValueRef
getCalledValue :: FunctionRef -> IO FunctionRef
getCalledValue = FunctionRef -> IO FunctionRef
Raw.getCalledValue


-- ** Call instructions
isTailCall :: ValueRef -> IO LLVM.Bool
isTailCall :: FunctionRef -> IO Bool
isTailCall = FunctionRef -> IO Bool
Raw.isTailCall

setTailCall :: ValueRef -> LLVM.Bool -> IO ()
setTailCall :: FunctionRef -> Bool -> IO ()
setTailCall = FunctionRef -> Bool -> IO ()
Raw.setTailCall


-- ** Switch Instructions
getSwitchDefaultDest :: ValueRef -> IO BasicBlockRef
getSwitchDefaultDest :: FunctionRef -> IO BasicBlockRef
getSwitchDefaultDest = FunctionRef -> IO BasicBlockRef
Raw.getSwitchDefaultDest


-- ** Phi Nodes
addIncoming :: ValueRef -> Ptr ValueRef -> Ptr BasicBlockRef -> CUInt -> IO ()
addIncoming :: FunctionRef
-> Ptr FunctionRef -> Ptr BasicBlockRef -> CUInt -> IO ()
addIncoming = FunctionRef
-> Ptr FunctionRef -> Ptr BasicBlockRef -> CUInt -> IO ()
Raw.addIncoming

countIncoming :: ValueRef -> IO CUInt
countIncoming :: FunctionRef -> IO CUInt
countIncoming = FunctionRef -> IO CUInt
Raw.countIncoming

getIncomingValue :: ValueRef -> CUInt -> IO ValueRef
getIncomingValue :: FunctionRef -> CUInt -> IO FunctionRef
getIncomingValue = FunctionRef -> CUInt -> IO FunctionRef
Raw.getIncomingValue

getIncomingBlock :: ValueRef -> CUInt -> IO BasicBlockRef
getIncomingBlock :: FunctionRef -> CUInt -> IO BasicBlockRef
getIncomingBlock = FunctionRef -> CUInt -> IO BasicBlockRef
Raw.getIncomingBlock


-- ** Builders
createBuilderInContext :: ContextRef -> IO BuilderRef
createBuilderInContext :: ContextRef -> IO BuilderRef
createBuilderInContext = ContextRef -> IO BuilderRef
Raw.createBuilderInContext

createBuilder :: IO BuilderRef
createBuilder :: IO BuilderRef
createBuilder = IO BuilderRef
Raw.createBuilder

positionBuilder :: BuilderRef -> BasicBlockRef -> ValueRef -> IO ()
positionBuilder :: BuilderRef -> BasicBlockRef -> FunctionRef -> IO ()
positionBuilder = BuilderRef -> BasicBlockRef -> FunctionRef -> IO ()
Raw.positionBuilder

positionBefore :: BuilderRef -> ValueRef -> IO ()
positionBefore :: BuilderRef -> FunctionRef -> IO ()
positionBefore = BuilderRef -> FunctionRef -> IO ()
Raw.positionBuilderBefore

positionAtEnd :: BuilderRef -> BasicBlockRef -> IO ()
positionAtEnd :: BuilderRef -> BasicBlockRef -> IO ()
positionAtEnd = BuilderRef -> BasicBlockRef -> IO ()
Raw.positionBuilderAtEnd

getInsertBlock :: BuilderRef -> IO BasicBlockRef
getInsertBlock :: BuilderRef -> IO BasicBlockRef
getInsertBlock = BuilderRef -> IO BasicBlockRef
Raw.getInsertBlock

clearInsertionPosition :: BuilderRef -> IO ()
clearInsertionPosition :: BuilderRef -> IO ()
clearInsertionPosition = BuilderRef -> IO ()
Raw.clearInsertionPosition

insertIntoBuilder :: BuilderRef -> ValueRef -> IO ()
insertIntoBuilder :: BuilderRef -> FunctionRef -> IO ()
insertIntoBuilder = BuilderRef -> FunctionRef -> IO ()
Raw.insertIntoBuilder

insertIntoBuilderWithName :: BuilderRef -> ValueRef -> CString -> IO ()
insertIntoBuilderWithName :: BuilderRef -> FunctionRef -> CString -> IO ()
insertIntoBuilderWithName = BuilderRef -> FunctionRef -> CString -> IO ()
Raw.insertIntoBuilderWithName

foreign import ccall unsafe "&LLVMDisposeBuilder" ptrDisposeBuilder
    :: LLVM.FinalizerPtr Raw.Builder


-- ** Metadata
getCurrentDebugLocation :: BuilderRef -> IO ValueRef
getCurrentDebugLocation :: BuilderRef -> IO FunctionRef
getCurrentDebugLocation = BuilderRef -> IO FunctionRef
Raw.getCurrentDebugLocation

setCurrentDebugLocation :: BuilderRef -> ValueRef -> IO ()
setCurrentDebugLocation :: BuilderRef -> FunctionRef -> IO ()
setCurrentDebugLocation = BuilderRef -> FunctionRef -> IO ()
Raw.setCurrentDebugLocation

setInstDebugLocation :: BuilderRef -> ValueRef -> IO ()
setInstDebugLocation :: BuilderRef -> FunctionRef -> IO ()
setInstDebugLocation = BuilderRef -> FunctionRef -> IO ()
Raw.setInstDebugLocation


-- ** Terminators
buildRetVoid :: BuilderRef -> IO ValueRef
buildRetVoid :: BuilderRef -> IO FunctionRef
buildRetVoid = BuilderRef -> IO FunctionRef
Raw.buildRetVoid

buildRet :: BuilderRef -> ValueRef -> IO ValueRef
buildRet :: BuilderRef -> FunctionRef -> IO FunctionRef
buildRet = BuilderRef -> FunctionRef -> IO FunctionRef
Raw.buildRet

buildAggregateRet :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef
buildAggregateRet :: BuilderRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
buildAggregateRet = BuilderRef -> Ptr FunctionRef -> CUInt -> IO FunctionRef
Raw.buildAggregateRet

buildBr :: BuilderRef -> BasicBlockRef -> IO ValueRef
buildBr :: BuilderRef -> BasicBlockRef -> IO FunctionRef
buildBr = BuilderRef -> BasicBlockRef -> IO FunctionRef
Raw.buildBr

buildCondBr :: BuilderRef -> ValueRef -> BasicBlockRef -> BasicBlockRef -> IO ValueRef
buildCondBr :: BuilderRef
-> FunctionRef -> BasicBlockRef -> BasicBlockRef -> IO FunctionRef
buildCondBr = BuilderRef
-> FunctionRef -> BasicBlockRef -> BasicBlockRef -> IO FunctionRef
Raw.buildCondBr

buildSwitch :: BuilderRef -> ValueRef -> BasicBlockRef -> CUInt -> IO ValueRef
buildSwitch :: BuilderRef
-> FunctionRef -> BasicBlockRef -> CUInt -> IO FunctionRef
buildSwitch = BuilderRef
-> FunctionRef -> BasicBlockRef -> CUInt -> IO FunctionRef
Raw.buildSwitch

buildIndirectBr :: BuilderRef -> ValueRef -> CUInt -> IO ValueRef
buildIndirectBr :: BuilderRef -> FunctionRef -> CUInt -> IO FunctionRef
buildIndirectBr = BuilderRef -> FunctionRef -> CUInt -> IO FunctionRef
Raw.buildIndirectBr

buildInvoke2 :: BuilderRef -> TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> BasicBlockRef -> BasicBlockRef -> CString -> IO ValueRef
buildInvoke2 :: BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> BasicBlockRef
-> BasicBlockRef
-> CString
-> IO FunctionRef
buildInvoke2 = BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> BasicBlockRef
-> BasicBlockRef
-> CString
-> IO FunctionRef
Core14.buildInvoke2

buildLandingPad :: BuilderRef -> TypeRef -> ValueRef -> CUInt -> CString -> IO ValueRef
buildLandingPad :: BuilderRef
-> TypeRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
buildLandingPad = BuilderRef
-> TypeRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
Raw.buildLandingPad

buildResume :: BuilderRef -> ValueRef -> IO ValueRef
buildResume :: BuilderRef -> FunctionRef -> IO FunctionRef
buildResume = BuilderRef -> FunctionRef -> IO FunctionRef
Raw.buildResume

buildUnreachable :: BuilderRef -> IO ValueRef
buildUnreachable :: BuilderRef -> IO FunctionRef
buildUnreachable = BuilderRef -> IO FunctionRef
Raw.buildUnreachable


-- ** Switch instructions
addCase :: ValueRef -> ValueRef -> BasicBlockRef -> IO ()
addCase :: FunctionRef -> FunctionRef -> BasicBlockRef -> IO ()
addCase = FunctionRef -> FunctionRef -> BasicBlockRef -> IO ()
Raw.addCase


-- ** IndirectBr instructions
addDestination :: ValueRef -> BasicBlockRef -> IO ()
addDestination :: FunctionRef -> BasicBlockRef -> IO ()
addDestination = FunctionRef -> BasicBlockRef -> IO ()
Raw.addDestination


-- ** LandingPad instructions
addClause :: ValueRef -> ValueRef -> IO ()
addClause :: FunctionRef -> FunctionRef -> IO ()
addClause = FunctionRef -> FunctionRef -> IO ()
Raw.addClause


-- ** Resume instructions
setCleanup :: ValueRef -> LLVM.Bool -> IO ()
setCleanup :: FunctionRef -> Bool -> IO ()
setCleanup = FunctionRef -> Bool -> IO ()
Raw.setCleanup


-- ** Arithmetic
buildAdd :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildAdd :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildAdd = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildAdd

buildNSWAdd :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNSWAdd :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNSWAdd = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNSWAdd

buildNUWAdd :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNUWAdd :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNUWAdd = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNUWAdd

buildFAdd :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFAdd :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildFAdd = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFAdd

buildSub :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildSub :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildSub = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildSub

buildNSWSub :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNSWSub :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNSWSub = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNSWSub

buildNUWSub :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNUWSub :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNUWSub = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNUWSub

buildFSub :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFSub :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildFSub = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFSub

buildMul :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildMul :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildMul = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildMul

buildNSWMul :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNSWMul :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNSWMul = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNSWMul

buildNUWMul :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildNUWMul :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildNUWMul = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNUWMul

buildFMul :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFMul :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildFMul = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFMul

buildUDiv :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildUDiv :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildUDiv = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildUDiv

buildSDiv :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildSDiv :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildSDiv = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildSDiv

buildExactSDiv :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildExactSDiv :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildExactSDiv = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildExactSDiv

buildFDiv :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFDiv :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildFDiv = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFDiv

buildURem :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildURem :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildURem = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildURem

buildSRem :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildSRem :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildSRem = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildSRem

buildFRem :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFRem :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildFRem = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFRem

buildShl :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildShl :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildShl = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildShl

buildLShr :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildLShr :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildLShr = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildLShr

buildAShr :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildAShr :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildAShr = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildAShr

buildAnd :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildAnd :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildAnd = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildAnd

buildOr :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildOr :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildOr = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildOr

buildXor :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildXor :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildXor = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildXor

buildBinOp :: BuilderRef -> Raw.Opcode -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildBinOp :: BuilderRef
-> Opcode
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildBinOp = BuilderRef
-> Opcode
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildBinOp

buildNeg :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildNeg :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildNeg = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNeg

buildNSWNeg :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildNSWNeg :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildNSWNeg = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNSWNeg

buildFNeg :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildFNeg :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildFNeg = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildFNeg

buildNot :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildNot :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildNot = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildNot


-- ** Floating point attributes
foreign import ccall unsafe "LLVMSetHasUnsafeAlgebra" setFastMath
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasUnsafeAlgebra" setHasUnsafeAlgebra
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasNoNaNs" setHasNoNaNs
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasNoInfs" setHasNoInfs
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasNoSignedZeros" setHasNoSignedZeros
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasAllowReciprocal" setHasAllowReciprocal
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasAllowReassoc" setHasAllowReassoc
    :: ValueRef -> LLVM.Bool -> IO ()
foreign import ccall unsafe "LLVMSetHasApproxFunc" setHasApproxFunc
    :: ValueRef -> LLVM.Bool -> IO ()


-- ** Memory
buildMalloc :: BuilderRef -> TypeRef -> CString -> IO ValueRef
buildMalloc :: BuilderRef -> TypeRef -> CString -> IO FunctionRef
buildMalloc = BuilderRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildMalloc

buildArrayMalloc :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef
buildArrayMalloc :: BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
buildArrayMalloc = BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildArrayMalloc

buildAlloca :: BuilderRef -> TypeRef -> CString -> IO ValueRef
buildAlloca :: BuilderRef -> TypeRef -> CString -> IO FunctionRef
buildAlloca = BuilderRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildAlloca

buildArrayAlloca :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef
buildArrayAlloca :: BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
buildArrayAlloca = BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildArrayAlloca

buildFree :: BuilderRef -> ValueRef -> IO ValueRef
buildFree :: BuilderRef -> FunctionRef -> IO FunctionRef
buildFree = BuilderRef -> FunctionRef -> IO FunctionRef
Raw.buildFree

buildLoad2 :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef
buildLoad2 :: BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
buildLoad2 = BuilderRef -> TypeRef -> FunctionRef -> CString -> IO FunctionRef
Core14.buildLoad2

buildStore :: BuilderRef -> ValueRef -> ValueRef -> IO ValueRef
buildStore :: BuilderRef -> FunctionRef -> FunctionRef -> IO FunctionRef
buildStore = BuilderRef -> FunctionRef -> FunctionRef -> IO FunctionRef
Raw.buildStore

buildGEP2 :: BuilderRef -> TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef
buildGEP2 :: BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
buildGEP2 = BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
Core14.buildGEP2

buildInBoundsGEP2 :: BuilderRef -> TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef
buildInBoundsGEP2 :: BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
buildInBoundsGEP2 = BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
Core14.buildInBoundsGEP2

buildStructGEP2 :: BuilderRef -> TypeRef -> ValueRef -> CUInt -> CString -> IO ValueRef
buildStructGEP2 :: BuilderRef
-> TypeRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
buildStructGEP2 = BuilderRef
-> TypeRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
Core14.buildStructGEP2

buildGlobalString :: BuilderRef -> CString -> CString -> IO ValueRef
buildGlobalString :: BuilderRef -> CString -> CString -> IO FunctionRef
buildGlobalString = BuilderRef -> CString -> CString -> IO FunctionRef
Raw.buildGlobalString

buildGlobalStringPtr :: BuilderRef -> CString -> CString -> IO ValueRef
buildGlobalStringPtr :: BuilderRef -> CString -> CString -> IO FunctionRef
buildGlobalStringPtr = BuilderRef -> CString -> CString -> IO FunctionRef
Raw.buildGlobalStringPtr


-- Casts
buildTrunc :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildTrunc :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildTrunc = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildTrunc

buildZExt :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildZExt :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildZExt = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildZExt

buildSExt :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildSExt :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildSExt = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildSExt

buildFPToUI :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildFPToUI :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildFPToUI = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildFPToUI

buildFPToSI :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildFPToSI :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildFPToSI = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildFPToSI

buildUIToFP :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildUIToFP :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildUIToFP = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildUIToFP

buildSIToFP :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildSIToFP :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildSIToFP = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildSIToFP

buildFPTrunc :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildFPTrunc :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildFPTrunc = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildFPTrunc

buildFPExt :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildFPExt :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildFPExt = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildFPExt

buildPtrToInt :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildPtrToInt :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildPtrToInt = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildPtrToInt

buildIntToPtr :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildIntToPtr :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildIntToPtr = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildIntToPtr

buildBitCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildBitCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildBitCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildBitCast

buildZExtOrBitCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildZExtOrBitCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildZExtOrBitCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildZExtOrBitCast

buildSExtOrBitCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildSExtOrBitCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildSExtOrBitCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildSExtOrBitCast

buildTruncOrBitCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildTruncOrBitCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildTruncOrBitCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildTruncOrBitCast

buildCast :: BuilderRef -> Raw.Opcode -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildCast :: BuilderRef
-> Opcode -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildCast = BuilderRef
-> Opcode -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildCast

buildPointerCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildPointerCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildPointerCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildPointerCast

foreign import ccall unsafe "LLVMBuildIntCast" buildIntCast
    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef

buildFPCast :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildFPCast :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildFPCast = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildFPCast


-- Comparisons
buildICmp :: BuilderRef -> Raw.IntPredicate -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildICmp :: BuilderRef
-> IntPredicate
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildICmp = BuilderRef
-> IntPredicate
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildICmp

buildFCmp :: BuilderRef -> Raw.RealPredicate -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildFCmp :: BuilderRef
-> RealPredicate
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildFCmp = BuilderRef
-> RealPredicate
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildFCmp


-- Miscellaneous instructions
buildPhi :: BuilderRef -> TypeRef -> CString -> IO ValueRef
buildPhi :: BuilderRef -> TypeRef -> CString -> IO FunctionRef
buildPhi = BuilderRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildPhi

buildCall2 :: BuilderRef -> TypeRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef
buildCall2 :: BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
buildCall2 = BuilderRef
-> TypeRef
-> FunctionRef
-> Ptr FunctionRef
-> CUInt
-> CString
-> IO FunctionRef
Core14.buildCall2

buildSelect :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildSelect :: BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildSelect = BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildSelect

buildVAArg :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef
buildVAArg :: BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
buildVAArg = BuilderRef -> FunctionRef -> TypeRef -> CString -> IO FunctionRef
Raw.buildVAArg

buildExtractElement :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildExtractElement :: BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
buildExtractElement = BuilderRef
-> FunctionRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildExtractElement

buildInsertElement :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildInsertElement :: BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildInsertElement = BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildInsertElement

buildShuffleVector :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildShuffleVector :: BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildShuffleVector = BuilderRef
-> FunctionRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Raw.buildShuffleVector

buildExtractValue :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef
buildExtractValue :: BuilderRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
buildExtractValue = BuilderRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
Raw.buildExtractValue

buildInsertValue :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef
buildInsertValue :: BuilderRef
-> FunctionRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
buildInsertValue = BuilderRef
-> FunctionRef -> FunctionRef -> CUInt -> CString -> IO FunctionRef
Raw.buildInsertValue

buildIsNull :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildIsNull :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildIsNull = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildIsNull

buildIsNotNull :: BuilderRef -> ValueRef -> CString -> IO ValueRef
buildIsNotNull :: BuilderRef -> FunctionRef -> CString -> IO FunctionRef
buildIsNotNull = BuilderRef -> FunctionRef -> CString -> IO FunctionRef
Raw.buildIsNotNull

buildPtrDiff2 :: BuilderRef -> TypeRef -> ValueRef -> ValueRef -> CString -> IO ValueRef
buildPtrDiff2 :: BuilderRef
-> TypeRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
buildPtrDiff2 = BuilderRef
-> TypeRef
-> FunctionRef
-> FunctionRef
-> CString
-> IO FunctionRef
Core14.buildPtrDiff2


-- ** Memory Buffers
createMemoryBufferWithContentsOfFile :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO LLVM.Bool
createMemoryBufferWithContentsOfFile :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO Bool
createMemoryBufferWithContentsOfFile = CString -> Ptr MemoryBufferRef -> Ptr CString -> IO Bool
Raw.createMemoryBufferWithContentsOfFile

createMemoryBufferWithSTDIN :: Ptr MemoryBufferRef -> Ptr CString -> IO LLVM.Bool
createMemoryBufferWithSTDIN :: Ptr MemoryBufferRef -> Ptr CString -> IO Bool
createMemoryBufferWithSTDIN = Ptr MemoryBufferRef -> Ptr CString -> IO Bool
Raw.createMemoryBufferWithSTDIN

disposeMemoryBuffer :: MemoryBufferRef -> IO ()
disposeMemoryBuffer :: MemoryBufferRef -> IO ()
disposeMemoryBuffer = MemoryBufferRef -> IO ()
Raw.disposeMemoryBuffer


-- ** Pass Managers
createPassManager :: IO PassManagerRef
createPassManager :: IO PassManagerRef
createPassManager = IO PassManagerRef
Raw.createPassManager

createFunctionPassManagerForModule :: ModuleRef -> IO PassManagerRef
createFunctionPassManagerForModule :: ModuleRef -> IO PassManagerRef
createFunctionPassManagerForModule = ModuleRef -> IO PassManagerRef
Raw.createFunctionPassManagerForModule

runPassManager :: PassManagerRef -> ModuleRef -> IO LLVM.Bool
runPassManager :: PassManagerRef -> ModuleRef -> IO Bool
runPassManager = PassManagerRef -> ModuleRef -> IO Bool
Raw.runPassManager

initializeFunctionPassManager :: PassManagerRef -> IO LLVM.Bool
initializeFunctionPassManager :: PassManagerRef -> IO Bool
initializeFunctionPassManager = PassManagerRef -> IO Bool
Raw.initializeFunctionPassManager

runFunctionPassManager :: PassManagerRef -> ValueRef -> IO LLVM.Bool
runFunctionPassManager :: PassManagerRef -> FunctionRef -> IO Bool
runFunctionPassManager = PassManagerRef -> FunctionRef -> IO Bool
Raw.runFunctionPassManager

finalizeFunctionPassManager :: PassManagerRef -> IO LLVM.Bool
finalizeFunctionPassManager :: PassManagerRef -> IO Bool
finalizeFunctionPassManager = PassManagerRef -> IO Bool
Raw.finalizeFunctionPassManager

disposePassManager :: PassManagerRef -> IO ()
disposePassManager :: PassManagerRef -> IO ()
disposePassManager = PassManagerRef -> IO ()
Raw.disposePassManager

foreign import ccall unsafe "&LLVMDisposePassManager" ptrDisposePassManager
    :: LLVM.FinalizerPtr Raw.PassManager


-- ** Functions from extras.cpp
foreign import ccall unsafe "LLVMValueGetNumUses" getNumUses
    :: ValueRef -> IO CInt
foreign import ccall unsafe "LLVMInstGetOpcode" instGetOpcode
    :: ValueRef -> IO CInt
foreign import ccall unsafe "LLVMCmpInstGetPredicate" cmpInstGetIntPredicate
    :: ValueRef -> IO Raw.IntPredicate
foreign import ccall unsafe "LLVMCmpInstGetPredicate" cmpInstGetRealPredicate
    :: ValueRef -> IO Raw.RealPredicate