{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE DeriveDataTypeable #-}

module LLVM.FFI.ExecutionEngine
    (
    -- * Linking
      linkInInterpreter
    , linkInMCJIT

    -- * Generic values
    , GenericValue
    , GenericValueRef
    , createGenericValueOfInt
    , createGenericValueOfPointer
    , createGenericValueOfFloat
    , genericValueIntWidth
    , genericValueToInt
    , genericValueToPointer
    , genericValueToFloat
    , ptrDisposeGenericValue

    -- * Execution engines
    , ExecutionEngine
    , ExecutionEngineRef
    , EngineKind(..)
    , EngineKindSet
    , kindJIT
    , kindInterpreter
    , kindEither
    , createExecutionEngineKindForModuleCPU
    , createExecutionEngineForModule
    , createExecutionEngineForModuleCPU
    , createInterpreterForModule
    , createInterpreterForModuleCPU
    , createJITCompilerForModule
    , createMCJITCompilerForModule
    , initializeMCJITCompilerOptions
    , ptrDisposeExecutionEngine
    , disposeExecutionEngine
    , runStaticConstructors
    , runStaticDestructors
    , runFunctionAsMain
    , freeMachineCodeForFunction
    , addModule
    , removeModule
    , findFunction
    , recompileAndRelinkFunction
    , runFunction
    , getExecutionEngineTargetData
    , TargetMachine
    , TargetMachineRef
    , getExecutionEngineTargetMachine
    , addGlobalMapping
    , addFunctionMapping
    , getPointerToGlobal
    , getPointerToFunction

    ) where

import qualified LLVM.FFI.Core as LLVM
import LLVM.FFI.Core (ModuleRef, TypeRef, ValueRef)
import LLVM.FFI.Target (TargetDataRef)
import LLVM.FFI.Base (FinalizerPtr)

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

import qualified Data.EnumBitSet as EnumSet
import Data.Typeable (Typeable)


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


data ExecutionEngine
    deriving (Typeable)
type ExecutionEngineRef = Ptr ExecutionEngine

data TargetMachine
    deriving (Typeable)
type TargetMachineRef = Ptr TargetMachine

data GenericValue
    deriving (Typeable)
type GenericValueRef = Ptr GenericValue

data MCJITCompilerOptions
    deriving (Typeable)
type MCJITCompilerOptionsRef = Ptr MCJITCompilerOptions

-- ** Linking
foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter
    :: IO ()
foreign import ccall unsafe "LLVMLinkInMCJIT" linkInMCJIT
    :: IO ()

-- ** Generic values
foreign import ccall unsafe "LLVMCreateGenericValueOfInt"
    createGenericValueOfInt :: TypeRef -> CULLong -> LLVM.Bool
                            -> IO GenericValueRef
foreign import ccall unsafe "LLVMCreateGenericValueOfPointer"
    createGenericValueOfPointer :: Ptr a -> IO GenericValueRef
foreign import ccall unsafe "LLVMCreateGenericValueOfFloat"
    createGenericValueOfFloat :: TypeRef -> CDouble -> IO GenericValueRef
foreign import ccall unsafe "LLVMGenericValueIntWidth" genericValueIntWidth
    :: GenericValueRef -> IO CUInt
foreign import ccall unsafe "LLVMGenericValueToInt" genericValueToInt
    :: GenericValueRef -> LLVM.Bool -> IO CULLong
foreign import ccall unsafe "LLVMGenericValueToPointer" genericValueToPointer
    :: GenericValueRef -> IO (Ptr a)
foreign import ccall unsafe "LLVMGenericValueToFloat" genericValueToFloat
    :: TypeRef -> GenericValueRef -> IO CDouble
foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue
    :: FinalizerPtr GenericValue


data EngineKind
    = JIT
    | Interpreter
    deriving (EngineKind -> EngineKind -> Bool
(EngineKind -> EngineKind -> Bool)
-> (EngineKind -> EngineKind -> Bool) -> Eq EngineKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EngineKind -> EngineKind -> Bool
== :: EngineKind -> EngineKind -> Bool
$c/= :: EngineKind -> EngineKind -> Bool
/= :: EngineKind -> EngineKind -> Bool
Eq, Eq EngineKind
Eq EngineKind
-> (EngineKind -> EngineKind -> Ordering)
-> (EngineKind -> EngineKind -> Bool)
-> (EngineKind -> EngineKind -> Bool)
-> (EngineKind -> EngineKind -> Bool)
-> (EngineKind -> EngineKind -> Bool)
-> (EngineKind -> EngineKind -> EngineKind)
-> (EngineKind -> EngineKind -> EngineKind)
-> Ord EngineKind
EngineKind -> EngineKind -> Bool
EngineKind -> EngineKind -> Ordering
EngineKind -> EngineKind -> EngineKind
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 :: EngineKind -> EngineKind -> Ordering
compare :: EngineKind -> EngineKind -> Ordering
$c< :: EngineKind -> EngineKind -> Bool
< :: EngineKind -> EngineKind -> Bool
$c<= :: EngineKind -> EngineKind -> Bool
<= :: EngineKind -> EngineKind -> Bool
$c> :: EngineKind -> EngineKind -> Bool
> :: EngineKind -> EngineKind -> Bool
$c>= :: EngineKind -> EngineKind -> Bool
>= :: EngineKind -> EngineKind -> Bool
$cmax :: EngineKind -> EngineKind -> EngineKind
max :: EngineKind -> EngineKind -> EngineKind
$cmin :: EngineKind -> EngineKind -> EngineKind
min :: EngineKind -> EngineKind -> EngineKind
Ord, Int -> EngineKind
EngineKind -> Int
EngineKind -> [EngineKind]
EngineKind -> EngineKind
EngineKind -> EngineKind -> [EngineKind]
EngineKind -> EngineKind -> EngineKind -> [EngineKind]
(EngineKind -> EngineKind)
-> (EngineKind -> EngineKind)
-> (Int -> EngineKind)
-> (EngineKind -> Int)
-> (EngineKind -> [EngineKind])
-> (EngineKind -> EngineKind -> [EngineKind])
-> (EngineKind -> EngineKind -> [EngineKind])
-> (EngineKind -> EngineKind -> EngineKind -> [EngineKind])
-> Enum EngineKind
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 :: EngineKind -> EngineKind
succ :: EngineKind -> EngineKind
$cpred :: EngineKind -> EngineKind
pred :: EngineKind -> EngineKind
$ctoEnum :: Int -> EngineKind
toEnum :: Int -> EngineKind
$cfromEnum :: EngineKind -> Int
fromEnum :: EngineKind -> Int
$cenumFrom :: EngineKind -> [EngineKind]
enumFrom :: EngineKind -> [EngineKind]
$cenumFromThen :: EngineKind -> EngineKind -> [EngineKind]
enumFromThen :: EngineKind -> EngineKind -> [EngineKind]
$cenumFromTo :: EngineKind -> EngineKind -> [EngineKind]
enumFromTo :: EngineKind -> EngineKind -> [EngineKind]
$cenumFromThenTo :: EngineKind -> EngineKind -> EngineKind -> [EngineKind]
enumFromThenTo :: EngineKind -> EngineKind -> EngineKind -> [EngineKind]
Enum, EngineKind
EngineKind -> EngineKind -> Bounded EngineKind
forall a. a -> a -> Bounded a
$cminBound :: EngineKind
minBound :: EngineKind
$cmaxBound :: EngineKind
maxBound :: EngineKind
Bounded, Int -> EngineKind -> ShowS
[EngineKind] -> ShowS
EngineKind -> String
(Int -> EngineKind -> ShowS)
-> (EngineKind -> String)
-> ([EngineKind] -> ShowS)
-> Show EngineKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EngineKind -> ShowS
showsPrec :: Int -> EngineKind -> ShowS
$cshow :: EngineKind -> String
show :: EngineKind -> String
$cshowList :: [EngineKind] -> ShowS
showList :: [EngineKind] -> ShowS
Show, ReadPrec [EngineKind]
ReadPrec EngineKind
Int -> ReadS EngineKind
ReadS [EngineKind]
(Int -> ReadS EngineKind)
-> ReadS [EngineKind]
-> ReadPrec EngineKind
-> ReadPrec [EngineKind]
-> Read EngineKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EngineKind
readsPrec :: Int -> ReadS EngineKind
$creadList :: ReadS [EngineKind]
readList :: ReadS [EngineKind]
$creadPrec :: ReadPrec EngineKind
readPrec :: ReadPrec EngineKind
$creadListPrec :: ReadPrec [EngineKind]
readListPrec :: ReadPrec [EngineKind]
Read, Typeable)

type EngineKindSet = EnumSet.T CUInt EngineKind

kindJIT, kindInterpreter, kindEither :: EngineKindSet
kindJIT :: EngineKindSet
kindJIT = EngineKind -> EngineKindSet
forall a w. (Enum a, Bits w) => a -> T w a
EnumSet.fromEnum EngineKind
JIT
kindInterpreter :: EngineKindSet
kindInterpreter = EngineKind -> EngineKindSet
forall a w. (Enum a, Bits w) => a -> T w a
EnumSet.fromEnum EngineKind
Interpreter
kindEither :: EngineKindSet
kindEither = EngineKindSet
kindJIT EngineKindSet -> EngineKindSet -> EngineKindSet
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
EnumSet..|. EngineKindSet
kindInterpreter

-- ** Execution engines
foreign import ccall unsafe "LLVMCreateExecutionEngineKindForModuleCPU" createExecutionEngineKindForModuleCPU
    :: (Ptr ExecutionEngineRef) -> EngineKindSet -> ModuleRef -> (Ptr CString) -> IO LLVM.Bool
{-# INLINE createExecutionEngineForModuleCPU #-}
createExecutionEngineForModuleCPU
    :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO LLVM.Bool
createExecutionEngineForModuleCPU :: Ptr ExecutionEngineRef -> ModuleRef -> Ptr CString -> IO Bool
createExecutionEngineForModuleCPU Ptr ExecutionEngineRef
ee ModuleRef
m Ptr CString
outError =
    Ptr ExecutionEngineRef
-> EngineKindSet -> ModuleRef -> Ptr CString -> IO Bool
createExecutionEngineKindForModuleCPU Ptr ExecutionEngineRef
ee EngineKindSet
kindEither ModuleRef
m Ptr CString
outError
{-# INLINE createInterpreterForModuleCPU #-}
createInterpreterForModuleCPU
    :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO LLVM.Bool
createInterpreterForModuleCPU :: Ptr ExecutionEngineRef -> ModuleRef -> Ptr CString -> IO Bool
createInterpreterForModuleCPU Ptr ExecutionEngineRef
ee ModuleRef
m Ptr CString
outError =
    Ptr ExecutionEngineRef
-> EngineKindSet -> ModuleRef -> Ptr CString -> IO Bool
createExecutionEngineKindForModuleCPU Ptr ExecutionEngineRef
ee EngineKindSet
kindInterpreter ModuleRef
m Ptr CString
outError

foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule
    :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO LLVM.Bool
foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule
    :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO LLVM.Bool
foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule
    :: (Ptr ExecutionEngineRef) -> ModuleRef -> CUInt -> (Ptr CString) -> IO LLVM.Bool
foreign import ccall unsafe "LLVMInitializeMCJITCompilerOptions" initializeMCJITCompilerOptions
    :: MCJITCompilerOptionsRef -> CSize -> IO ()
foreign import ccall unsafe "LLVMCreateMCJITCompilerForModule" createMCJITCompilerForModule
    :: Ptr ExecutionEngineRef -> ModuleRef -> MCJITCompilerOptionsRef -> CSize -> Ptr CString -> IO LLVM.Bool
foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine
    :: ExecutionEngineRef -> IO ()
foreign import ccall unsafe "&LLVMDisposeExecutionEngine" ptrDisposeExecutionEngine
    :: FinalizerPtr ExecutionEngine
foreign import ccall unsafe "LLVMRunStaticConstructors" runStaticConstructors
    :: ExecutionEngineRef -> IO ()
foreign import ccall unsafe "LLVMRunStaticDestructors" runStaticDestructors
    :: ExecutionEngineRef -> IO ()
{-
safe call is important, since the running LLVM code may call back into Haskell code

See
http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-130003.3 says:

"Optionally, an import declaration can specify,
after the calling  convention,
the safety level that should be used when invoking an external entity.
..."
-}
foreign import ccall safe "LLVMRunFunctionAsMain" runFunctionAsMain
    :: ExecutionEngineRef -> ValueRef -> CUInt
    -> Ptr CString              -- ^ argv
    -> Ptr CString              -- ^ envp
    -> IO CInt
foreign import ccall safe "LLVMRunFunction" runFunction
    :: ExecutionEngineRef -> ValueRef -> CUInt
    -> Ptr GenericValueRef -> IO GenericValueRef
foreign import ccall unsafe "LLVMFreeMachineCodeForFunction"
    freeMachineCodeForFunction :: ExecutionEngineRef -> ValueRef -> IO ()
foreign import ccall unsafe "LLVMAddModule" addModule
    :: ExecutionEngineRef -> ModuleRef -> IO ()
foreign import ccall unsafe "LLVMRemoveModule" removeModule
    :: ExecutionEngineRef -> ModuleRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO LLVM.Bool
foreign import ccall unsafe "LLVMFindFunction" findFunction
    :: ExecutionEngineRef -> CString -> Ptr ValueRef -> IO LLVM.Bool
foreign import ccall unsafe "LLVMRecompileAndRelinkFunction" recompileAndRelinkFunction
    :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a)
foreign import ccall unsafe "LLVMGetExecutionEngineTargetData" getExecutionEngineTargetData
    :: ExecutionEngineRef -> IO TargetDataRef
foreign import ccall unsafe "LLVMGetExecutionEngineTargetMachine" getExecutionEngineTargetMachine
    :: ExecutionEngineRef -> IO TargetMachineRef

{- |
disfunctional in LLVM-3.6,
see <https://llvm.org/bugs/show_bug.cgi?id=20656>
-}
foreign import ccall unsafe "LLVMAddGlobalMapping" addGlobalMapping
    :: ExecutionEngineRef -> ValueRef -> Ptr a -> IO ()
foreign import ccall unsafe "LLVMAddGlobalMapping" addFunctionMapping
    :: ExecutionEngineRef -> ValueRef -> FunPtr a -> IO ()
foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal
    :: ExecutionEngineRef -> ValueRef -> IO (Ptr a)
foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToFunction
    :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a)