{-#
LANGUAGE
ForeignFunctionInterface,
TemplateHaskell,
ViewPatterns
#-}
module LLVM.Internal.FFI.Builder where
import LLVM.Prelude
import qualified Language.Haskell.TH as TH
import Foreign.Ptr
import Foreign.C
import qualified Data.List as List
import qualified Data.Map as Map
import qualified LLVM.AST.Instruction as A
import LLVM.Internal.InstructionDefs as ID
import LLVM.Internal.FFI.Cleanup
import LLVM.Internal.FFI.Context
import LLVM.Internal.FFI.LLVMCTypes
import LLVM.Internal.FFI.PtrHierarchy
data Builder
foreign import ccall unsafe "LLVMCreateBuilderInContext" createBuilderInContext ::
Ptr Context -> IO (Ptr Builder)
foreign import ccall unsafe "LLVMDisposeBuilder" disposeBuilder ::
Ptr Builder -> IO ()
foreign import ccall unsafe "LLVMPositionBuilderAtEnd" positionBuilderAtEnd ::
Ptr Builder -> Ptr BasicBlock -> IO ()
foreign import ccall unsafe "LLVMBuildRet" buildRet ::
Ptr Builder -> Ptr Value -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildBr" buildBr ::
Ptr Builder -> Ptr BasicBlock -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildCondBr" buildCondBr ::
Ptr Builder -> Ptr Value -> Ptr BasicBlock -> Ptr BasicBlock -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildSwitch" buildSwitch ::
Ptr Builder -> Ptr Value -> Ptr BasicBlock -> CUInt -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildIndirectBr" buildIndirectBr ::
Ptr Builder -> Ptr Value -> CUInt -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildInvoke" buildInvoke ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt
-> Ptr BasicBlock -> Ptr BasicBlock -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildResume" buildResume ::
Ptr Builder -> Ptr Value -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildUnreachable" buildUnreachable ::
Ptr Builder -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildCleanupRet" buildCleanupRet ::
Ptr Builder -> Ptr Value -> Ptr BasicBlock -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildCatchRet" buildCatchRet ::
Ptr Builder -> Ptr Value -> Ptr BasicBlock -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildCatchSwitch" buildCatchSwitch ::
Ptr Builder -> Ptr Value -> Ptr BasicBlock -> CUInt -> IO (Ptr Instruction)
$(do
liftM concat $ sequence $ do
let instrInfo = ID.outerJoin ID.astInstructionRecs ID.instructionDefs
(lrn, ii) <- Map.toList instrInfo
(TH.RecC _ (unzip3 -> (_, _, fieldTypes)), ID.InstructionDef { ID.cAPIName = a, ID.instructionKind = k }) <- case ii of
(Just r, Just d) -> return (r,d)
(Just _, Nothing) -> error $ "An AST instruction was not found in the LLVM instruction defs"
(Nothing, Just ID.InstructionDef { ID.instructionKind = k }) | k /= ID.Terminator ->
error $ "LLVM instruction def " ++ lrn ++ " not found in the AST"
_ -> []
let ats = map typeMapping (fieldTypes List.\\ [TH.ConT ''A.InstructionMetadata, TH.ConT ''A.FastMathFlags])
cName = "LLVM_Hs_Build" ++ a
rt <- case k of
ID.Binary -> [[t| BinaryOperator |]]
ID.Cast -> [[t| Instruction |]]
_ -> []
return $ foreignDecl cName ("build" ++ a) ([[t| Ptr Builder |]] ++ ats ++ [[t| CString |]]) [t| Ptr $(rt) |]
)
foreign import ccall unsafe "LLVMBuildArrayAlloca" buildAlloca ::
Ptr Builder -> Ptr Type -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildLoad" buildLoad' ::
Ptr Builder -> LLVMBool -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction)
buildLoad :: Ptr Builder -> LLVMBool -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CUInt -> CString -> IO (Ptr Instruction)
buildLoad :: Ptr Builder
-> LLVMBool
-> Ptr Value
-> (SynchronizationScope, MemoryOrdering)
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildLoad builder :: Ptr Builder
builder vol :: LLVMBool
vol a' :: Ptr Value
a' (ss :: SynchronizationScope
ss, mo :: MemoryOrdering
mo) al :: CUInt
al s :: CString
s = Ptr Builder
-> LLVMBool
-> Ptr Value
-> MemoryOrdering
-> SynchronizationScope
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildLoad' Ptr Builder
builder LLVMBool
vol Ptr Value
a' MemoryOrdering
mo SynchronizationScope
ss CUInt
al CString
s
foreign import ccall unsafe "LLVM_Hs_BuildStore" buildStore' ::
Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction)
buildStore :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CUInt -> CString -> IO (Ptr Instruction)
buildStore :: Ptr Builder
-> LLVMBool
-> Ptr Value
-> Ptr Value
-> (SynchronizationScope, MemoryOrdering)
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildStore builder :: Ptr Builder
builder vol :: LLVMBool
vol a' :: Ptr Value
a' v' :: Ptr Value
v' (ss :: SynchronizationScope
ss, mo :: MemoryOrdering
mo) al :: CUInt
al s :: CString
s = Ptr Builder
-> LLVMBool
-> Ptr Value
-> Ptr Value
-> MemoryOrdering
-> SynchronizationScope
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildStore' Ptr Builder
builder LLVMBool
vol Ptr Value
a' Ptr Value
v' MemoryOrdering
mo SynchronizationScope
ss CUInt
al CString
s
foreign import ccall unsafe "LLVM_Hs_BuildGEP" buildGetElementPtr' ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildInBoundsGEP" buildInBoundsGetElementPtr' ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)
buildGetElementPtr :: Ptr Builder -> LLVMBool -> Ptr Value -> (CUInt, Ptr (Ptr Value)) -> CString -> IO (Ptr Instruction)
buildGetElementPtr :: Ptr Builder
-> LLVMBool
-> Ptr Value
-> (CUInt, Ptr (Ptr Value))
-> CString
-> IO (Ptr Instruction)
buildGetElementPtr builder :: Ptr Builder
builder (LLVMBool 1) a :: Ptr Value
a (n :: CUInt
n, is :: Ptr (Ptr Value)
is) s :: CString
s = Ptr Builder
-> Ptr Value
-> Ptr (Ptr Value)
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildInBoundsGetElementPtr' Ptr Builder
builder Ptr Value
a Ptr (Ptr Value)
is CUInt
n CString
s
buildGetElementPtr builder :: Ptr Builder
builder (LLVMBool 0) a :: Ptr Value
a (n :: CUInt
n, is :: Ptr (Ptr Value)
is) s :: CString
s = Ptr Builder
-> Ptr Value
-> Ptr (Ptr Value)
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildGetElementPtr' Ptr Builder
builder Ptr Value
a Ptr (Ptr Value)
is CUInt
n CString
s
buildGetElementPtr _ (LLVMBool i :: CUInt
i) _ _ _ = [Char] -> IO (Ptr Instruction)
forall a. HasCallStack => [Char] -> a
error ("LLVMBool should be 0 or 1 but is " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> CUInt -> [Char]
forall a. Show a => a -> [Char]
show CUInt
i)
foreign import ccall unsafe "LLVM_Hs_BuildFence" buildFence' ::
Ptr Builder -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction)
buildFence :: Ptr Builder -> (SynchronizationScope, MemoryOrdering) -> CString -> IO (Ptr Instruction)
buildFence :: Ptr Builder
-> (SynchronizationScope, MemoryOrdering)
-> CString
-> IO (Ptr Instruction)
buildFence builder :: Ptr Builder
builder (ss :: SynchronizationScope
ss, mo :: MemoryOrdering
mo) s :: CString
s = Ptr Builder
-> MemoryOrdering
-> SynchronizationScope
-> CString
-> IO (Ptr Instruction)
buildFence' Ptr Builder
builder MemoryOrdering
mo SynchronizationScope
ss CString
s
foreign import ccall unsafe "LLVM_Hs_BuildAtomicCmpXchg" buildCmpXchg' ::
Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> MemoryOrdering -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction)
buildCmpXchg :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> MemoryOrdering -> CString -> IO (Ptr Instruction)
buildCmpXchg :: Ptr Builder
-> LLVMBool
-> Ptr Value
-> Ptr Value
-> Ptr Value
-> (SynchronizationScope, MemoryOrdering)
-> MemoryOrdering
-> CString
-> IO (Ptr Instruction)
buildCmpXchg builder :: Ptr Builder
builder vol :: LLVMBool
vol a :: Ptr Value
a e :: Ptr Value
e r :: Ptr Value
r (ss :: SynchronizationScope
ss, smo :: MemoryOrdering
smo) fmo :: MemoryOrdering
fmo s :: CString
s = Ptr Builder
-> LLVMBool
-> Ptr Value
-> Ptr Value
-> Ptr Value
-> MemoryOrdering
-> MemoryOrdering
-> SynchronizationScope
-> CString
-> IO (Ptr Instruction)
buildCmpXchg' Ptr Builder
builder LLVMBool
vol Ptr Value
a Ptr Value
e Ptr Value
r MemoryOrdering
smo MemoryOrdering
fmo SynchronizationScope
ss CString
s
foreign import ccall unsafe "LLVM_Hs_BuildAtomicRMW" buildAtomicRMW' ::
Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction)
buildAtomicRMW :: Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CString -> IO (Ptr Instruction)
buildAtomicRMW :: Ptr Builder
-> LLVMBool
-> RMWOperation
-> Ptr Value
-> Ptr Value
-> (SynchronizationScope, MemoryOrdering)
-> CString
-> IO (Ptr Instruction)
buildAtomicRMW builder :: Ptr Builder
builder vol :: LLVMBool
vol rmwOp :: RMWOperation
rmwOp a :: Ptr Value
a v :: Ptr Value
v (ss :: SynchronizationScope
ss, mo :: MemoryOrdering
mo) s :: CString
s = Ptr Builder
-> LLVMBool
-> RMWOperation
-> Ptr Value
-> Ptr Value
-> MemoryOrdering
-> SynchronizationScope
-> CString
-> IO (Ptr Instruction)
buildAtomicRMW' Ptr Builder
builder LLVMBool
vol RMWOperation
rmwOp Ptr Value
a Ptr Value
v MemoryOrdering
mo SynchronizationScope
ss CString
s
foreign import ccall unsafe "LLVM_Hs_BuildICmp" buildICmp ::
Ptr Builder -> ICmpPredicate -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp ::
Ptr Builder -> FCmpPredicate -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildPhi" buildPhi ::
Ptr Builder -> Ptr Type -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildCall" buildCall ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildSelect" buildSelect ::
Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildVAArg" buildVAArg ::
Ptr Builder -> Ptr Value -> Ptr Type -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildExtractElement" ::
Ptr Builder -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildInsertElement" buildInsertElement ::
Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildShuffleVector" buildShuffleVector ::
Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Constant -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildExtractValue" ::
Ptr Builder -> Ptr Value -> Ptr CUInt -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildInsertValue" buildInsertValue ::
Ptr Builder -> Ptr Value -> Ptr Value -> Ptr CUInt -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVMBuildLandingPad" buildLandingPad' ::
Ptr Builder -> Ptr Type -> Ptr Value -> CUInt -> CString -> IO (Ptr Instruction)
buildLandingPad :: Ptr Builder -> Ptr Type -> CUInt -> CString -> IO (Ptr Instruction)
buildLandingPad :: Ptr Builder -> Ptr Type -> CUInt -> CString -> IO (Ptr Instruction)
buildLandingPad builder :: Ptr Builder
builder ty :: Ptr Type
ty numClauses :: CUInt
numClauses name :: CString
name = Ptr Builder
-> Ptr Type
-> Ptr Value
-> CUInt
-> CString
-> IO (Ptr Instruction)
buildLandingPad' Ptr Builder
builder Ptr Type
ty Ptr Value
forall a. Ptr a
nullPtr CUInt
numClauses CString
name
foreign import ccall unsafe "LLVM_Hs_BuildCleanupPad" buildCleanupPad ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_BuildCatchPad" buildCatchPad ::
Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)
foreign import ccall unsafe "LLVM_Hs_SetFastMathFlags" setFastMathFlags ::
Ptr Builder -> FastMathFlags -> IO ()