{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module LLVM.Internal.OrcJIT where
import LLVM.Prelude
import Control.Exception
import Control.Monad.AnyCont
import Control.Monad.IO.Class
import Data.Bits
import Data.IORef
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import LLVM.Internal.Coding
import LLVM.Internal.Module (Module, readModule)
import LLVM.Internal.Target (TargetMachine(..))
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import qualified LLVM.Internal.FFI.ShortByteString as SBS
import qualified LLVM.Internal.FFI.DataLayout as FFI
import qualified LLVM.Internal.FFI.OrcJIT as FFI
import qualified LLVM.Internal.FFI.Target as FFI
data ExecutionSession = ExecutionSession {
ExecutionSession -> Ptr ExecutionSession
sessionPtr :: !(Ptr FFI.ExecutionSession),
ExecutionSession -> IORef [IO ()]
sessionCleanups :: !(IORef [IO ()])
}
createExecutionSession :: IO ExecutionSession
createExecutionSession :: IO ExecutionSession
createExecutionSession = Ptr ExecutionSession -> IORef [IO ()] -> ExecutionSession
ExecutionSession (Ptr ExecutionSession -> IORef [IO ()] -> ExecutionSession)
-> IO (Ptr ExecutionSession)
-> IO (IORef [IO ()] -> ExecutionSession)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ExecutionSession)
FFI.createExecutionSession IO (IORef [IO ()] -> ExecutionSession)
-> IO (IORef [IO ()]) -> IO ExecutionSession
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef []
disposeExecutionSession :: ExecutionSession -> IO ()
disposeExecutionSession :: ExecutionSession -> IO ()
disposeExecutionSession (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
cleanups) = do
Ptr ExecutionSession -> IO ()
FFI.endSession Ptr ExecutionSession
es
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> IO [IO ()] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORef IORef [IO ()]
cleanups
Ptr ExecutionSession -> IO ()
FFI.disposeExecutionSession Ptr ExecutionSession
es
withExecutionSession :: (ExecutionSession -> IO a) -> IO a
withExecutionSession :: forall a. (ExecutionSession -> IO a) -> IO a
withExecutionSession = IO ExecutionSession
-> (ExecutionSession -> IO ())
-> (ExecutionSession -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ExecutionSession
createExecutionSession ExecutionSession -> IO ()
disposeExecutionSession
data JITSymbolFlags =
JITSymbolFlags {
JITSymbolFlags -> Bool
jitSymbolWeak :: !Bool
, JITSymbolFlags -> Bool
jitSymbolCommon :: !Bool
, JITSymbolFlags -> Bool
jitSymbolAbsolute :: !Bool
, JITSymbolFlags -> Bool
jitSymbolExported :: !Bool
, JITSymbolFlags -> Bool
jitSymbolCallable :: !Bool
, JITSymbolFlags -> Bool
jitSymbolMaterializationSideEffectsOnly :: !Bool
}
deriving (Int -> JITSymbolFlags -> ShowS
[JITSymbolFlags] -> ShowS
JITSymbolFlags -> String
(Int -> JITSymbolFlags -> ShowS)
-> (JITSymbolFlags -> String)
-> ([JITSymbolFlags] -> ShowS)
-> Show JITSymbolFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JITSymbolFlags -> ShowS
showsPrec :: Int -> JITSymbolFlags -> ShowS
$cshow :: JITSymbolFlags -> String
show :: JITSymbolFlags -> String
$cshowList :: [JITSymbolFlags] -> ShowS
showList :: [JITSymbolFlags] -> ShowS
Show, JITSymbolFlags -> JITSymbolFlags -> Bool
(JITSymbolFlags -> JITSymbolFlags -> Bool)
-> (JITSymbolFlags -> JITSymbolFlags -> Bool) -> Eq JITSymbolFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JITSymbolFlags -> JITSymbolFlags -> Bool
== :: JITSymbolFlags -> JITSymbolFlags -> Bool
$c/= :: JITSymbolFlags -> JITSymbolFlags -> Bool
/= :: JITSymbolFlags -> JITSymbolFlags -> Bool
Eq, Eq JITSymbolFlags
Eq JITSymbolFlags
-> (JITSymbolFlags -> JITSymbolFlags -> Ordering)
-> (JITSymbolFlags -> JITSymbolFlags -> Bool)
-> (JITSymbolFlags -> JITSymbolFlags -> Bool)
-> (JITSymbolFlags -> JITSymbolFlags -> Bool)
-> (JITSymbolFlags -> JITSymbolFlags -> Bool)
-> (JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags)
-> (JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags)
-> Ord JITSymbolFlags
JITSymbolFlags -> JITSymbolFlags -> Bool
JITSymbolFlags -> JITSymbolFlags -> Ordering
JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
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 :: JITSymbolFlags -> JITSymbolFlags -> Ordering
compare :: JITSymbolFlags -> JITSymbolFlags -> Ordering
$c< :: JITSymbolFlags -> JITSymbolFlags -> Bool
< :: JITSymbolFlags -> JITSymbolFlags -> Bool
$c<= :: JITSymbolFlags -> JITSymbolFlags -> Bool
<= :: JITSymbolFlags -> JITSymbolFlags -> Bool
$c> :: JITSymbolFlags -> JITSymbolFlags -> Bool
> :: JITSymbolFlags -> JITSymbolFlags -> Bool
$c>= :: JITSymbolFlags -> JITSymbolFlags -> Bool
>= :: JITSymbolFlags -> JITSymbolFlags -> Bool
$cmax :: JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
max :: JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
$cmin :: JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
min :: JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
Ord)
defaultJITSymbolFlags :: JITSymbolFlags
defaultJITSymbolFlags :: JITSymbolFlags
defaultJITSymbolFlags = Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> JITSymbolFlags
JITSymbolFlags Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False
data JITSymbol =
JITSymbol {
JITSymbol -> WordPtr
jitSymbolAddress :: !WordPtr,
JITSymbol -> JITSymbolFlags
jitSymbolFlags :: !JITSymbolFlags
}
deriving (Int -> JITSymbol -> ShowS
[JITSymbol] -> ShowS
JITSymbol -> String
(Int -> JITSymbol -> ShowS)
-> (JITSymbol -> String)
-> ([JITSymbol] -> ShowS)
-> Show JITSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JITSymbol -> ShowS
showsPrec :: Int -> JITSymbol -> ShowS
$cshow :: JITSymbol -> String
show :: JITSymbol -> String
$cshowList :: [JITSymbol] -> ShowS
showList :: [JITSymbol] -> ShowS
Show, JITSymbol -> JITSymbol -> Bool
(JITSymbol -> JITSymbol -> Bool)
-> (JITSymbol -> JITSymbol -> Bool) -> Eq JITSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JITSymbol -> JITSymbol -> Bool
== :: JITSymbol -> JITSymbol -> Bool
$c/= :: JITSymbol -> JITSymbol -> Bool
/= :: JITSymbol -> JITSymbol -> Bool
Eq, Eq JITSymbol
Eq JITSymbol
-> (JITSymbol -> JITSymbol -> Ordering)
-> (JITSymbol -> JITSymbol -> Bool)
-> (JITSymbol -> JITSymbol -> Bool)
-> (JITSymbol -> JITSymbol -> Bool)
-> (JITSymbol -> JITSymbol -> Bool)
-> (JITSymbol -> JITSymbol -> JITSymbol)
-> (JITSymbol -> JITSymbol -> JITSymbol)
-> Ord JITSymbol
JITSymbol -> JITSymbol -> Bool
JITSymbol -> JITSymbol -> Ordering
JITSymbol -> JITSymbol -> JITSymbol
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 :: JITSymbol -> JITSymbol -> Ordering
compare :: JITSymbol -> JITSymbol -> Ordering
$c< :: JITSymbol -> JITSymbol -> Bool
< :: JITSymbol -> JITSymbol -> Bool
$c<= :: JITSymbol -> JITSymbol -> Bool
<= :: JITSymbol -> JITSymbol -> Bool
$c> :: JITSymbol -> JITSymbol -> Bool
> :: JITSymbol -> JITSymbol -> Bool
$c>= :: JITSymbol -> JITSymbol -> Bool
>= :: JITSymbol -> JITSymbol -> Bool
$cmax :: JITSymbol -> JITSymbol -> JITSymbol
max :: JITSymbol -> JITSymbol -> JITSymbol
$cmin :: JITSymbol -> JITSymbol -> JITSymbol
min :: JITSymbol -> JITSymbol -> JITSymbol
Ord)
data JITSymbolError = JITSymbolError ShortByteString
deriving (Int -> JITSymbolError -> ShowS
[JITSymbolError] -> ShowS
JITSymbolError -> String
(Int -> JITSymbolError -> ShowS)
-> (JITSymbolError -> String)
-> ([JITSymbolError] -> ShowS)
-> Show JITSymbolError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JITSymbolError -> ShowS
showsPrec :: Int -> JITSymbolError -> ShowS
$cshow :: JITSymbolError -> String
show :: JITSymbolError -> String
$cshowList :: [JITSymbolError] -> ShowS
showList :: [JITSymbolError] -> ShowS
Show, JITSymbolError -> JITSymbolError -> Bool
(JITSymbolError -> JITSymbolError -> Bool)
-> (JITSymbolError -> JITSymbolError -> Bool) -> Eq JITSymbolError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JITSymbolError -> JITSymbolError -> Bool
== :: JITSymbolError -> JITSymbolError -> Bool
$c/= :: JITSymbolError -> JITSymbolError -> Bool
/= :: JITSymbolError -> JITSymbolError -> Bool
Eq)
instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where
encodeM :: HasCallStack => JITSymbolFlags -> m JITSymbolFlags
encodeM JITSymbolFlags
f = JITSymbolFlags -> m JITSymbolFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (JITSymbolFlags -> m JITSymbolFlags)
-> JITSymbolFlags -> m JITSymbolFlags
forall a b. (a -> b) -> a -> b
$ (JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags)
-> [JITSymbolFlags] -> JITSymbolFlags
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
(.|.) [
if JITSymbolFlags -> Bool
a JITSymbolFlags
f
then JITSymbolFlags
b
else JITSymbolFlags
0
| (JITSymbolFlags -> Bool
a,JITSymbolFlags
b) <- [
(JITSymbolFlags -> Bool
jitSymbolWeak, JITSymbolFlags
FFI.jitSymbolFlagsWeak),
(JITSymbolFlags -> Bool
jitSymbolCommon, JITSymbolFlags
FFI.jitSymbolFlagsCommon),
(JITSymbolFlags -> Bool
jitSymbolAbsolute, JITSymbolFlags
FFI.jitSymbolFlagsAbsolute),
(JITSymbolFlags -> Bool
jitSymbolExported, JITSymbolFlags
FFI.jitSymbolFlagsExported),
(JITSymbolFlags -> Bool
jitSymbolCallable, JITSymbolFlags
FFI.jitSymbolFlagsCallable),
(JITSymbolFlags -> Bool
jitSymbolMaterializationSideEffectsOnly, JITSymbolFlags
FFI.jitSymbolFlagsMaterializationSideEffectsOnly)
]
]
instance Monad m => DecodeM m JITSymbolFlags FFI.JITSymbolFlags where
decodeM :: HasCallStack => JITSymbolFlags -> m JITSymbolFlags
decodeM JITSymbolFlags
f =
JITSymbolFlags -> m JITSymbolFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (JITSymbolFlags -> m JITSymbolFlags)
-> JITSymbolFlags -> m JITSymbolFlags
forall a b. (a -> b) -> a -> b
$ JITSymbolFlags {
jitSymbolWeak :: Bool
jitSymbolWeak = JITSymbolFlags
FFI.jitSymbolFlagsWeak JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0,
jitSymbolCommon :: Bool
jitSymbolCommon = JITSymbolFlags
FFI.jitSymbolFlagsCommon JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0,
jitSymbolAbsolute :: Bool
jitSymbolAbsolute = JITSymbolFlags
FFI.jitSymbolFlagsAbsolute JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0,
jitSymbolExported :: Bool
jitSymbolExported = JITSymbolFlags
FFI.jitSymbolFlagsExported JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0,
jitSymbolCallable :: Bool
jitSymbolCallable = JITSymbolFlags
FFI.jitSymbolFlagsCallable JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0,
jitSymbolMaterializationSideEffectsOnly :: Bool
jitSymbolMaterializationSideEffectsOnly = JITSymbolFlags
FFI.jitSymbolFlagsMaterializationSideEffectsOnly JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
f JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0
}
instance Monad m => EncodeM m MangledSymbol (Ptr FFI.SymbolStringPtr) where
encodeM :: HasCallStack => MangledSymbol -> m (Ptr SymbolStringPtr)
encodeM (MangledSymbol Ptr SymbolStringPtr
p) = Ptr SymbolStringPtr -> m (Ptr SymbolStringPtr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SymbolStringPtr
p
instance (Monad m, MonadIO m, MonadAnyCont IO m) => EncodeM m JITSymbol (Ptr FFI.JITEvaluatedSymbol) where
encodeM :: HasCallStack => JITSymbol -> m (Ptr JITEvaluatedSymbol)
encodeM (JITSymbol WordPtr
addr JITSymbolFlags
flags) = do
JITSymbolFlags
flags' <- JITSymbolFlags -> m JITSymbolFlags
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM JITSymbolFlags
flags
(forall r. (Ptr JITEvaluatedSymbol -> IO r) -> IO r)
-> m (Ptr JITEvaluatedSymbol)
forall a. (forall r. (a -> IO r) -> IO r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Ptr JITEvaluatedSymbol -> IO r) -> IO r)
-> m (Ptr JITEvaluatedSymbol))
-> (forall r. (Ptr JITEvaluatedSymbol -> IO r) -> IO r)
-> m (Ptr JITEvaluatedSymbol)
forall a b. (a -> b) -> a -> b
$ IO (Ptr JITEvaluatedSymbol)
-> (Ptr JITEvaluatedSymbol -> IO ())
-> (Ptr JITEvaluatedSymbol -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(TargetAddress -> JITSymbolFlags -> IO (Ptr JITEvaluatedSymbol)
FFI.createJITEvaluatedSymbol (Word64 -> TargetAddress
FFI.TargetAddress (Word64 -> TargetAddress) -> Word64 -> TargetAddress
forall a b. (a -> b) -> a -> b
$ WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordPtr
addr) JITSymbolFlags
flags')
Ptr JITEvaluatedSymbol -> IO ()
FFI.disposeJITEvaluatedSymbol
instance (MonadIO m, MonadAnyCont IO m) =>
DecodeM m (Either JITSymbolError JITSymbol) (Ptr FFI.ExpectedJITEvaluatedSymbol) where
decodeM :: HasCallStack =>
Ptr ExpectedJITEvaluatedSymbol
-> m (Either JITSymbolError JITSymbol)
decodeM Ptr ExpectedJITEvaluatedSymbol
expectedSym = do
Ptr (OwnerTransfered CString)
errMsg <- m (Ptr (OwnerTransfered CString))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
FFI.TargetAddress Word64
addr <- IO TargetAddress -> m TargetAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetAddress -> m TargetAddress)
-> IO TargetAddress -> m TargetAddress
forall a b. (a -> b) -> a -> b
$ Ptr ExpectedJITEvaluatedSymbol
-> Ptr (OwnerTransfered CString) -> IO TargetAddress
FFI.getExpectedSymbolAddress Ptr ExpectedJITEvaluatedSymbol
expectedSym Ptr (OwnerTransfered CString)
errMsg
JITSymbolFlags
rawFlags <- IO JITSymbolFlags -> m JITSymbolFlags
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr ExpectedJITEvaluatedSymbol -> IO JITSymbolFlags
FFI.getExpectedSymbolFlags Ptr ExpectedJITEvaluatedSymbol
expectedSym)
if Word64
addr Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| (JITSymbolFlags
rawFlags JITSymbolFlags -> JITSymbolFlags -> JITSymbolFlags
forall a. Bits a => a -> a -> a
.&. JITSymbolFlags
FFI.jitSymbolFlagsHasError JITSymbolFlags -> JITSymbolFlags -> Bool
forall a. Eq a => a -> a -> Bool
/= JITSymbolFlags
0)
then do
ShortByteString
errMsg <- Ptr (OwnerTransfered CString) -> m ShortByteString
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr (OwnerTransfered CString)
errMsg
Either JITSymbolError JITSymbol
-> m (Either JITSymbolError JITSymbol)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JITSymbolError -> Either JITSymbolError JITSymbol
forall a b. a -> Either a b
Left (ShortByteString -> JITSymbolError
JITSymbolError ShortByteString
errMsg))
else do
JITSymbolFlags
flags <- JITSymbolFlags -> m JITSymbolFlags
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM JITSymbolFlags
rawFlags
Either JITSymbolError JITSymbol
-> m (Either JITSymbolError JITSymbol)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JITSymbol -> Either JITSymbolError JITSymbol
forall a b. b -> Either a b
Right (WordPtr -> JITSymbolFlags -> JITSymbol
JITSymbol (Word64 -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
addr) JITSymbolFlags
flags))
newtype JITDylib = JITDylib (Ptr FFI.JITDylib)
createJITDylib :: ExecutionSession -> ShortByteString -> IO JITDylib
createJITDylib :: ExecutionSession -> ShortByteString -> IO JITDylib
createJITDylib (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
_) ShortByteString
name =
ShortByteString -> (CString -> IO JITDylib) -> IO JITDylib
forall a. ShortByteString -> (CString -> IO a) -> IO a
SBS.useAsCString ShortByteString
name ((CString -> IO JITDylib) -> IO JITDylib)
-> (CString -> IO JITDylib) -> IO JITDylib
forall a b. (a -> b) -> a -> b
$ (Ptr JITDylib -> JITDylib) -> IO (Ptr JITDylib) -> IO JITDylib
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr JITDylib -> JITDylib
JITDylib (IO (Ptr JITDylib) -> IO JITDylib)
-> (CString -> IO (Ptr JITDylib)) -> CString -> IO JITDylib
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ExecutionSession -> CString -> IO (Ptr JITDylib)
FFI.createJITDylib Ptr ExecutionSession
es
addDynamicLibrarySearchGeneratorForCurrentProcess :: IRLayer l => l -> JITDylib -> IO ()
addDynamicLibrarySearchGeneratorForCurrentProcess :: forall l. IRLayer l => l -> JITDylib -> IO ()
addDynamicLibrarySearchGeneratorForCurrentProcess l
compileLayer (JITDylib Ptr JITDylib
dylib) =
Ptr JITDylib -> Ptr DataLayout -> IO ()
FFI.addDynamicLibrarySearchGeneratorForCurrentProcess Ptr JITDylib
dylib (l -> Ptr DataLayout
forall l. IRLayer l => l -> Ptr DataLayout
getDataLayout l
compileLayer)
addDynamicLibrarySearchGenerator :: IRLayer l => l -> JITDylib -> FilePath -> IO ()
addDynamicLibrarySearchGenerator :: forall l. IRLayer l => l -> JITDylib -> String -> IO ()
addDynamicLibrarySearchGenerator l
compileLayer (JITDylib Ptr JITDylib
dylib) String
s = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cStr ->
Ptr JITDylib -> Ptr DataLayout -> CString -> IO ()
FFI.addDynamicLibrarySearchGenerator Ptr JITDylib
dylib (l -> Ptr DataLayout
forall l. IRLayer l => l -> Ptr DataLayout
getDataLayout l
compileLayer) CString
cStr
defineAbsoluteSymbols :: JITDylib -> [(MangledSymbol, JITSymbol)] -> IO ()
defineAbsoluteSymbols :: JITDylib -> [(MangledSymbol, JITSymbol)] -> IO ()
defineAbsoluteSymbols (JITDylib Ptr JITDylib
dylib) [(MangledSymbol, JITSymbol)]
symList =
(() -> IO ()) -> AnyContT IO () -> IO ()
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(CUInt
nsyms, Ptr (Ptr SymbolStringPtr)
symStrPtrPtr) :: (CUInt, Ptr (Ptr FFI.SymbolStringPtr)) <- [MangledSymbol] -> AnyContT IO (CUInt, Ptr (Ptr SymbolStringPtr))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM [MangledSymbol]
symNames
(CUInt
_, Ptr (Ptr JITEvaluatedSymbol)
symValPtrPtr) :: (CUInt, Ptr (Ptr FFI.JITEvaluatedSymbol)) <- [JITSymbol] -> AnyContT IO (CUInt, Ptr (Ptr JITEvaluatedSymbol))
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM [JITSymbol]
symVals
IO () -> AnyContT IO ()
forall a. IO a -> AnyContT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AnyContT IO ()) -> IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr JITDylib
-> CUInt
-> Ptr (Ptr SymbolStringPtr)
-> Ptr (Ptr JITEvaluatedSymbol)
-> IO ()
FFI.defineAbsoluteSymbols Ptr JITDylib
dylib CUInt
nsyms Ptr (Ptr SymbolStringPtr)
symStrPtrPtr Ptr (Ptr JITEvaluatedSymbol)
symValPtrPtr
where ([MangledSymbol]
symNames, [JITSymbol]
symVals) = [(MangledSymbol, JITSymbol)] -> ([MangledSymbol], [JITSymbol])
forall a b. [(a, b)] -> ([a], [b])
unzip [(MangledSymbol, JITSymbol)]
symList
lookupSymbol :: IRLayer l => ExecutionSession -> l -> JITDylib -> ShortByteString -> IO (Either JITSymbolError JITSymbol)
lookupSymbol :: forall l.
IRLayer l =>
ExecutionSession
-> l
-> JITDylib
-> ShortByteString
-> IO (Either JITSymbolError JITSymbol)
lookupSymbol (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
_) l
irl (JITDylib Ptr JITDylib
dylib) ShortByteString
name = ShortByteString
-> (CString -> IO (Either JITSymbolError JITSymbol))
-> IO (Either JITSymbolError JITSymbol)
forall a. ShortByteString -> (CString -> IO a) -> IO a
SBS.useAsCString ShortByteString
name ((CString -> IO (Either JITSymbolError JITSymbol))
-> IO (Either JITSymbolError JITSymbol))
-> (CString -> IO (Either JITSymbolError JITSymbol))
-> IO (Either JITSymbolError JITSymbol)
forall a b. (a -> b) -> a -> b
$ \CString
nameStr ->
(Either JITSymbolError JITSymbol
-> IO (Either JITSymbolError JITSymbol))
-> AnyContT IO (Either JITSymbolError JITSymbol)
-> IO (Either JITSymbolError JITSymbol)
forall a (m :: * -> *) r. (a -> m r) -> AnyContT m a -> m r
runAnyContT' Either JITSymbolError JITSymbol
-> IO (Either JITSymbolError JITSymbol)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO (Either JITSymbolError JITSymbol)
-> IO (Either JITSymbolError JITSymbol))
-> AnyContT IO (Either JITSymbolError JITSymbol)
-> IO (Either JITSymbolError JITSymbol)
forall a b. (a -> b) -> a -> b
$ do
Ptr ExpectedJITEvaluatedSymbol
symbol <- (forall r. (Ptr ExpectedJITEvaluatedSymbol -> IO r) -> IO r)
-> AnyContT IO (Ptr ExpectedJITEvaluatedSymbol)
forall a. (forall r. (a -> IO r) -> IO r) -> AnyContT IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Ptr ExpectedJITEvaluatedSymbol -> IO r) -> IO r)
-> AnyContT IO (Ptr ExpectedJITEvaluatedSymbol))
-> (forall r. (Ptr ExpectedJITEvaluatedSymbol -> IO r) -> IO r)
-> AnyContT IO (Ptr ExpectedJITEvaluatedSymbol)
forall a b. (a -> b) -> a -> b
$ IO (Ptr ExpectedJITEvaluatedSymbol)
-> (Ptr ExpectedJITEvaluatedSymbol -> IO ())
-> (Ptr ExpectedJITEvaluatedSymbol -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Ptr ExecutionSession
-> Ptr JITDylib
-> Ptr MangleAndInterner
-> CString
-> IO (Ptr ExpectedJITEvaluatedSymbol)
FFI.lookupSymbol Ptr ExecutionSession
es Ptr JITDylib
dylib (l -> Ptr MangleAndInterner
forall l. IRLayer l => l -> Ptr MangleAndInterner
getMangler l
irl) CString
nameStr) Ptr ExpectedJITEvaluatedSymbol -> IO ()
FFI.disposeExpectedJITEvaluatedSymbol
Ptr ExpectedJITEvaluatedSymbol
-> AnyContT IO (Either JITSymbolError JITSymbol)
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr ExpectedJITEvaluatedSymbol
symbol
newtype ThreadSafeContext = ThreadSafeContext (Ptr FFI.ThreadSafeContext)
createThreadSafeContext :: IO ThreadSafeContext
createThreadSafeContext :: IO ThreadSafeContext
createThreadSafeContext = Ptr ThreadSafeContext -> ThreadSafeContext
ThreadSafeContext (Ptr ThreadSafeContext -> ThreadSafeContext)
-> IO (Ptr ThreadSafeContext) -> IO ThreadSafeContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ThreadSafeContext)
FFI.createThreadSafeContext
disposeThreadSafeContext :: ThreadSafeContext -> IO ()
disposeThreadSafeContext :: ThreadSafeContext -> IO ()
disposeThreadSafeContext (ThreadSafeContext Ptr ThreadSafeContext
ctx) = Ptr ThreadSafeContext -> IO ()
FFI.disposeThreadSafeContext Ptr ThreadSafeContext
ctx
withThreadSafeContext :: (ThreadSafeContext -> IO a) -> IO a
withThreadSafeContext :: forall a. (ThreadSafeContext -> IO a) -> IO a
withThreadSafeContext = IO ThreadSafeContext
-> (ThreadSafeContext -> IO ())
-> (ThreadSafeContext -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ThreadSafeContext
createThreadSafeContext ThreadSafeContext -> IO ()
disposeThreadSafeContext
newtype ThreadSafeModule = ThreadSafeModule (Ptr FFI.ThreadSafeModule)
cloneAsThreadSafeModule :: Module -> IO ThreadSafeModule
cloneAsThreadSafeModule :: Module -> IO ThreadSafeModule
cloneAsThreadSafeModule Module
m = do
Ptr Module
mPtr <- Module -> IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
Ptr ThreadSafeModule -> ThreadSafeModule
ThreadSafeModule (Ptr ThreadSafeModule -> ThreadSafeModule)
-> IO (Ptr ThreadSafeModule) -> IO ThreadSafeModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Module -> IO (Ptr ThreadSafeModule)
FFI.cloneAsThreadSafeModule Ptr Module
mPtr
disposeThreadSafeModule :: ThreadSafeModule -> IO ()
disposeThreadSafeModule :: ThreadSafeModule -> IO ()
disposeThreadSafeModule (ThreadSafeModule Ptr ThreadSafeModule
m) = Ptr ThreadSafeModule -> IO ()
FFI.disposeThreadSafeModule Ptr ThreadSafeModule
m
withClonedThreadSafeModule :: Module -> (ThreadSafeModule -> IO a) -> IO a
withClonedThreadSafeModule :: forall a. Module -> (ThreadSafeModule -> IO a) -> IO a
withClonedThreadSafeModule Module
m = IO ThreadSafeModule
-> (ThreadSafeModule -> IO ())
-> (ThreadSafeModule -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Module -> IO ThreadSafeModule
cloneAsThreadSafeModule Module
m) ThreadSafeModule -> IO ()
disposeThreadSafeModule
class ObjectLayer l where
getObjectLayer :: l -> Ptr FFI.ObjectLayer
data RTDyldObjectLinkingLayer = RTDyldObjectLinkingLayer !(Ptr FFI.ObjectLayer)
instance ObjectLayer RTDyldObjectLinkingLayer where
getObjectLayer :: RTDyldObjectLinkingLayer -> Ptr ObjectLayer
getObjectLayer (RTDyldObjectLinkingLayer Ptr ObjectLayer
ol) = Ptr ObjectLayer
ol
createRTDyldObjectLinkingLayer :: ExecutionSession -> IO RTDyldObjectLinkingLayer
createRTDyldObjectLinkingLayer :: ExecutionSession -> IO RTDyldObjectLinkingLayer
createRTDyldObjectLinkingLayer (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
cleanups) = do
Ptr ObjectLayer
ol <- Ptr ExecutionSession -> IO (Ptr ObjectLayer)
FFI.createRTDyldObjectLinkingLayer Ptr ExecutionSession
es
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [IO ()]
cleanups (Ptr ObjectLayer -> IO ()
FFI.disposeObjectLayer Ptr ObjectLayer
ol IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
RTDyldObjectLinkingLayer -> IO RTDyldObjectLinkingLayer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RTDyldObjectLinkingLayer -> IO RTDyldObjectLinkingLayer)
-> RTDyldObjectLinkingLayer -> IO RTDyldObjectLinkingLayer
forall a b. (a -> b) -> a -> b
$ Ptr ObjectLayer -> RTDyldObjectLinkingLayer
RTDyldObjectLinkingLayer Ptr ObjectLayer
ol
data ObjectLinkingLayer = ObjectLinkingLayer !(Ptr FFI.ObjectLayer)
instance ObjectLayer ObjectLinkingLayer where
getObjectLayer :: ObjectLinkingLayer -> Ptr ObjectLayer
getObjectLayer (ObjectLinkingLayer Ptr ObjectLayer
ol) = Ptr ObjectLayer
ol
createObjectLinkingLayer :: ExecutionSession -> IO ObjectLinkingLayer
createObjectLinkingLayer :: ExecutionSession -> IO ObjectLinkingLayer
createObjectLinkingLayer (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
cleanups) = do
Ptr ObjectLayer
ol <- Ptr ExecutionSession -> IO (Ptr ObjectLayer)
FFI.createObjectLinkingLayer Ptr ExecutionSession
es
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [IO ()]
cleanups (Ptr ObjectLayer -> IO ()
FFI.disposeObjectLayer Ptr ObjectLayer
ol IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
ObjectLinkingLayer -> IO ObjectLinkingLayer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectLinkingLayer -> IO ObjectLinkingLayer)
-> ObjectLinkingLayer -> IO ObjectLinkingLayer
forall a b. (a -> b) -> a -> b
$ Ptr ObjectLayer -> ObjectLinkingLayer
ObjectLinkingLayer Ptr ObjectLayer
ol
addObjectFile :: ObjectLayer l => l -> JITDylib -> FilePath -> IO ()
addObjectFile :: forall l. ObjectLayer l => l -> JITDylib -> String -> IO ()
addObjectFile l
ol (JITDylib Ptr JITDylib
dylib) String
path = do
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cStr ->
Ptr ObjectLayer -> Ptr JITDylib -> CString -> IO ()
FFI.objectLayerAddObjectFile (l -> Ptr ObjectLayer
forall l. ObjectLayer l => l -> Ptr ObjectLayer
getObjectLayer l
ol) Ptr JITDylib
dylib CString
cStr
newtype MangledSymbol = MangledSymbol (Ptr FFI.SymbolStringPtr)
class IRLayer l where
getIRLayer :: l -> Ptr FFI.IRLayer
getDataLayout :: l -> Ptr FFI.DataLayout
getMangler :: l -> Ptr FFI.MangleAndInterner
addModule :: IRLayer l => ThreadSafeModule -> JITDylib -> l -> IO ()
addModule :: forall l. IRLayer l => ThreadSafeModule -> JITDylib -> l -> IO ()
addModule (ThreadSafeModule Ptr ThreadSafeModule
m) (JITDylib Ptr JITDylib
dylib) l
irl =
Ptr ThreadSafeModule
-> Ptr JITDylib -> Ptr DataLayout -> Ptr IRLayer -> IO ()
FFI.irLayerAddModule Ptr ThreadSafeModule
m Ptr JITDylib
dylib (l -> Ptr DataLayout
forall l. IRLayer l => l -> Ptr DataLayout
getDataLayout l
irl) (l -> Ptr IRLayer
forall l. IRLayer l => l -> Ptr IRLayer
getIRLayer l
irl)
mangleSymbol :: IRLayer l => l -> ShortByteString -> IO MangledSymbol
mangleSymbol :: forall l. IRLayer l => l -> ShortByteString -> IO MangledSymbol
mangleSymbol l
irl ShortByteString
name = ShortByteString
-> (CString -> IO MangledSymbol) -> IO MangledSymbol
forall a. ShortByteString -> (CString -> IO a) -> IO a
SBS.useAsCString ShortByteString
name ((CString -> IO MangledSymbol) -> IO MangledSymbol)
-> (CString -> IO MangledSymbol) -> IO MangledSymbol
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
Ptr SymbolStringPtr -> MangledSymbol
MangledSymbol (Ptr SymbolStringPtr -> MangledSymbol)
-> IO (Ptr SymbolStringPtr) -> IO MangledSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MangleAndInterner -> CString -> IO (Ptr SymbolStringPtr)
FFI.mangleSymbol (l -> Ptr MangleAndInterner
forall l. IRLayer l => l -> Ptr MangleAndInterner
getMangler l
irl) CString
namePtr
disposeMangledSymbol :: MangledSymbol -> IO ()
disposeMangledSymbol :: MangledSymbol -> IO ()
disposeMangledSymbol (MangledSymbol Ptr SymbolStringPtr
symbol) = Ptr SymbolStringPtr -> IO ()
FFI.disposeMangledSymbol Ptr SymbolStringPtr
symbol
withMangledSymbol :: IRLayer l => l -> ShortByteString -> (MangledSymbol -> IO a) -> IO a
withMangledSymbol :: forall l a.
IRLayer l =>
l -> ShortByteString -> (MangledSymbol -> IO a) -> IO a
withMangledSymbol l
irl ShortByteString
name = IO MangledSymbol
-> (MangledSymbol -> IO ()) -> (MangledSymbol -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (l -> ShortByteString -> IO MangledSymbol
forall l. IRLayer l => l -> ShortByteString -> IO MangledSymbol
mangleSymbol l
irl ShortByteString
name) MangledSymbol -> IO ()
disposeMangledSymbol
data IRCompileLayer = IRCompileLayer !(Ptr FFI.IRLayer) !(Ptr FFI.DataLayout) !(Ptr FFI.MangleAndInterner)
instance IRLayer IRCompileLayer where
getIRLayer :: IRCompileLayer -> Ptr IRLayer
getIRLayer (IRCompileLayer Ptr IRLayer
cl Ptr DataLayout
_ Ptr MangleAndInterner
_) = Ptr IRLayer
cl
getDataLayout :: IRCompileLayer -> Ptr DataLayout
getDataLayout (IRCompileLayer Ptr IRLayer
_ Ptr DataLayout
dl Ptr MangleAndInterner
_) = Ptr DataLayout
dl
getMangler :: IRCompileLayer -> Ptr MangleAndInterner
getMangler (IRCompileLayer Ptr IRLayer
_ Ptr DataLayout
_ Ptr MangleAndInterner
mg) = Ptr MangleAndInterner
mg
createIRCompileLayer :: ObjectLayer l => ExecutionSession -> l -> TargetMachine -> IO IRCompileLayer
createIRCompileLayer :: forall l.
ObjectLayer l =>
ExecutionSession -> l -> TargetMachine -> IO IRCompileLayer
createIRCompileLayer (ExecutionSession Ptr ExecutionSession
es IORef [IO ()]
cleanups) l
ol (TargetMachine Ptr TargetMachine
tm) = do
Ptr DataLayout
dl <- Ptr TargetMachine -> IO (Ptr DataLayout)
FFI.createTargetDataLayout Ptr TargetMachine
tm
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [IO ()]
cleanups (Ptr DataLayout -> IO ()
FFI.disposeDataLayout Ptr DataLayout
dl IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
Ptr MangleAndInterner
mg <- Ptr ExecutionSession
-> Ptr DataLayout -> IO (Ptr MangleAndInterner)
FFI.createMangleAndInterner Ptr ExecutionSession
es Ptr DataLayout
dl
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [IO ()]
cleanups (Ptr MangleAndInterner -> IO ()
FFI.disposeMangleAndInterner Ptr MangleAndInterner
mg IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
Ptr IRLayer
cl <- Ptr ExecutionSession
-> Ptr ObjectLayer -> Ptr TargetMachine -> IO (Ptr IRLayer)
FFI.createIRCompileLayer Ptr ExecutionSession
es (l -> Ptr ObjectLayer
forall l. ObjectLayer l => l -> Ptr ObjectLayer
getObjectLayer l
ol) Ptr TargetMachine
tm
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [IO ()]
cleanups (Ptr IRLayer -> IO ()
FFI.disposeIRLayer Ptr IRLayer
cl IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)
IRCompileLayer -> IO IRCompileLayer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IRCompileLayer -> IO IRCompileLayer)
-> IRCompileLayer -> IO IRCompileLayer
forall a b. (a -> b) -> a -> b
$ Ptr IRLayer
-> Ptr DataLayout -> Ptr MangleAndInterner -> IRCompileLayer
IRCompileLayer Ptr IRLayer
cl Ptr DataLayout
dl Ptr MangleAndInterner
mg