{-#
  LANGUAGE
  ForeignFunctionInterface,
  TemplateHaskell,
  ViewPatterns
  #-}
-- | FFI glue for llvm::IRBuilder - llvm's IR construction state object
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" 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" 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)

-- | The personality should be set via the function
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 ()