{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
module LLVM.Internal.OrcJIT.CompileOnDemandLayer where

import LLVM.Prelude

import Control.Exception
import Control.Monad.AnyCont
import Control.Monad.IO.Class
import Data.IORef
import Foreign.Ptr

import LLVM.Internal.Coding
import LLVM.Internal.OrcJIT
import LLVM.Internal.OrcJIT.CompileLayer
import LLVM.Internal.Target
import qualified LLVM.Internal.FFI.DataLayout as FFI
import qualified LLVM.Internal.FFI.OrcJIT as FFI
import qualified LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI

type PartitioningFn = Ptr FFI.Function -> IO [Ptr FFI.Function]

-- | This is used by 'CompileOnDemandLayer' to create callback that
-- compile functions when they are called.
data JITCompileCallbackManager =
  CallbackMgr !(Ptr FFI.JITCompileCallbackManager)
              !(IO ())

-- | This is used by 'CompileOnDemandLayer' to manage the stubs
-- created for function definitions that have not yet been compiled.
newtype IndirectStubsManagerBuilder =
  StubsMgr (Ptr FFI.IndirectStubsManagerBuilder)

-- | Adding a module to a 'CompileOnDemandLayer' creates stubs for its
-- functions definitions. When one of those stubs is called, the
-- corresponding function body is extracted and compiled.
data CompileOnDemandLayer baseLayer =
  CompileOnDemandLayer {
    CompileOnDemandLayer baseLayer -> Ptr CompileOnDemandLayer
compileLayer :: !(Ptr FFI.CompileOnDemandLayer),
    CompileOnDemandLayer baseLayer -> Ptr DataLayout
dataLayout :: !(Ptr FFI.DataLayout),
    CompileOnDemandLayer baseLayer -> IORef [IO ()]
cleanupActions :: !(IORef [IO ()])
  }
  deriving CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
(CompileOnDemandLayer baseLayer
 -> CompileOnDemandLayer baseLayer -> Bool)
-> (CompileOnDemandLayer baseLayer
    -> CompileOnDemandLayer baseLayer -> Bool)
-> Eq (CompileOnDemandLayer baseLayer)
forall baseLayer.
CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
$c/= :: forall baseLayer.
CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
== :: CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
$c== :: forall baseLayer.
CompileOnDemandLayer baseLayer
-> CompileOnDemandLayer baseLayer -> Bool
Eq

instance CompileLayer (CompileOnDemandLayer l) where
  getCompileLayer :: CompileOnDemandLayer l -> Ptr CompileLayer
getCompileLayer = Ptr CompileOnDemandLayer -> Ptr CompileLayer
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast (Ptr CompileOnDemandLayer -> Ptr CompileLayer)
-> (CompileOnDemandLayer l -> Ptr CompileOnDemandLayer)
-> CompileOnDemandLayer l
-> Ptr CompileLayer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileOnDemandLayer l -> Ptr CompileOnDemandLayer
forall baseLayer.
CompileOnDemandLayer baseLayer -> Ptr CompileOnDemandLayer
compileLayer
  getDataLayout :: CompileOnDemandLayer l -> Ptr DataLayout
getDataLayout = CompileOnDemandLayer l -> Ptr DataLayout
forall l. CompileOnDemandLayer l -> Ptr DataLayout
dataLayout
  getCleanups :: CompileOnDemandLayer l -> IORef [IO ()]
getCleanups = CompileOnDemandLayer l -> IORef [IO ()]
forall l. CompileOnDemandLayer l -> IORef [IO ()]
cleanupActions

instance MonadIO m =>
  EncodeM m PartitioningFn (IORef [IO ()] -> IO (FunPtr FFI.PartitioningFn)) where
  encodeM :: PartitioningFn -> m (IORef [IO ()] -> IO (FunPtr PartitioningFn))
encodeM partition :: PartitioningFn
partition = (IORef [IO ()] -> IO (FunPtr PartitioningFn))
-> m (IORef [IO ()] -> IO (FunPtr PartitioningFn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef [IO ()] -> IO (FunPtr PartitioningFn))
 -> m (IORef [IO ()] -> IO (FunPtr PartitioningFn)))
-> (IORef [IO ()] -> IO (FunPtr PartitioningFn))
-> m (IORef [IO ()] -> IO (FunPtr PartitioningFn))
forall a b. (a -> b) -> a -> b
$ \cleanups :: IORef [IO ()]
cleanups -> do
    IORef [IO ()]
-> IO (FunPtr PartitioningFn) -> IO (FunPtr PartitioningFn)
forall a. IORef [IO ()] -> IO (FunPtr a) -> IO (FunPtr a)
allocFunPtr
      IORef [IO ()]
cleanups
      (PartitioningFn -> IO (FunPtr PartitioningFn)
FFI.wrapPartitioningFn
         (\f :: Ptr Function
f set :: Ptr (Set (Ptr Function))
set -> do
           [Ptr Function]
fs <- PartitioningFn
partition Ptr Function
f
           (Ptr Function -> IO ()) -> [Ptr Function] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr (Set (Ptr Function)) -> Ptr Function -> IO ()
FFI.insertFun Ptr (Set (Ptr Function))
set) [Ptr Function]
fs
           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

instance (MonadIO m, MonadAnyCont IO m) =>
         EncodeM m (Maybe (IO ())) (FFI.TargetAddress, IO ()) where
  encodeM :: Maybe (IO ()) -> m (TargetAddress, IO ())
encodeM Nothing = (TargetAddress, IO ()) -> m (TargetAddress, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> TargetAddress
FFI.TargetAddress 0, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  encodeM (Just f :: IO ()
f) = do
    FunPtr (IO ())
f' <- (forall r. (FunPtr (IO ()) -> IO r) -> IO r) -> m (FunPtr (IO ()))
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (FunPtr (IO ()) -> IO r) -> IO r)
 -> m (FunPtr (IO ())))
-> (forall r. (FunPtr (IO ()) -> IO r) -> IO r)
-> m (FunPtr (IO ()))
forall a b. (a -> b) -> a -> b
$ IO (FunPtr (IO ()))
-> (FunPtr (IO ()) -> IO ()) -> (FunPtr (IO ()) -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (IO () -> IO (FunPtr (IO ()))
FFI.wrapErrorHandler IO ()
f) FunPtr (IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr
    (TargetAddress, IO ()) -> m (TargetAddress, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( (Word64 -> TargetAddress
FFI.TargetAddress (Word64 -> TargetAddress)
-> (FunPtr (IO ()) -> Word64) -> FunPtr (IO ()) -> TargetAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordPtr -> Word64)
-> (FunPtr (IO ()) -> WordPtr) -> FunPtr (IO ()) -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr (Ptr Any -> WordPtr)
-> (FunPtr (IO ()) -> Ptr Any) -> FunPtr (IO ()) -> WordPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunPtr (IO ()) -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr) FunPtr (IO ())
f'
      , FunPtr (IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (IO ())
f')

-- | Create a new 'IndirectStubsManagerBuilder'.
--
-- When the stubs manager is no longer needed, it should be freed
-- using 'disposeIndirectStubsManagerBuilder'.
newIndirectStubsManagerBuilder ::
  ShortByteString {- ^ target triple -} ->
  IO IndirectStubsManagerBuilder
newIndirectStubsManagerBuilder :: ShortByteString -> IO IndirectStubsManagerBuilder
newIndirectStubsManagerBuilder triple :: ShortByteString
triple =
  (AnyContT IO IndirectStubsManagerBuilder
 -> (IndirectStubsManagerBuilder -> IO IndirectStubsManagerBuilder)
 -> IO IndirectStubsManagerBuilder)
-> (IndirectStubsManagerBuilder -> IO IndirectStubsManagerBuilder)
-> AnyContT IO IndirectStubsManagerBuilder
-> IO IndirectStubsManagerBuilder
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO IndirectStubsManagerBuilder
-> (IndirectStubsManagerBuilder -> IO IndirectStubsManagerBuilder)
-> IO IndirectStubsManagerBuilder
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT IndirectStubsManagerBuilder -> IO IndirectStubsManagerBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO IndirectStubsManagerBuilder
 -> IO IndirectStubsManagerBuilder)
-> AnyContT IO IndirectStubsManagerBuilder
-> IO IndirectStubsManagerBuilder
forall a b. (a -> b) -> a -> b
$ do
    CString
triple' <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
triple
    Ptr IndirectStubsManagerBuilder
stubsMgr <- IO (Ptr IndirectStubsManagerBuilder)
-> AnyContT IO (Ptr IndirectStubsManagerBuilder)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CString -> IO (Ptr IndirectStubsManagerBuilder)
FFI.createLocalIndirectStubsManagerBuilder CString
triple')
    IndirectStubsManagerBuilder
-> AnyContT IO IndirectStubsManagerBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr IndirectStubsManagerBuilder -> IndirectStubsManagerBuilder
StubsMgr Ptr IndirectStubsManagerBuilder
stubsMgr)

-- | Dispose of an 'IndirectStubsManagerBuilder'.
disposeIndirectStubsManagerBuilder :: IndirectStubsManagerBuilder -> IO ()
disposeIndirectStubsManagerBuilder :: IndirectStubsManagerBuilder -> IO ()
disposeIndirectStubsManagerBuilder (StubsMgr stubsMgr :: Ptr IndirectStubsManagerBuilder
stubsMgr) =
  Ptr IndirectStubsManagerBuilder -> IO ()
FFI.disposeIndirectStubsManagerBuilder Ptr IndirectStubsManagerBuilder
stubsMgr

-- | 'bracket'-style wrapper around 'newIndirectStubsManagerBuilder'
-- and 'disposeIndirectStubsManagerBuilder'.
withIndirectStubsManagerBuilder ::
  ShortByteString {- ^ target triple -} ->
  (IndirectStubsManagerBuilder -> IO a) ->
  IO a
withIndirectStubsManagerBuilder :: ShortByteString -> (IndirectStubsManagerBuilder -> IO a) -> IO a
withIndirectStubsManagerBuilder triple :: ShortByteString
triple =
  IO IndirectStubsManagerBuilder
-> (IndirectStubsManagerBuilder -> IO ())
-> (IndirectStubsManagerBuilder -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (ShortByteString -> IO IndirectStubsManagerBuilder
newIndirectStubsManagerBuilder ShortByteString
triple)
    IndirectStubsManagerBuilder -> IO ()
disposeIndirectStubsManagerBuilder

-- | Create a new 'JITCompileCallbackManager'.
--
-- When the callback manager is no longer needed, it should be freed
-- using 'disposeJITCompileCallbackManager'.
newJITCompileCallbackManager ::
  ExecutionSession ->
  ShortByteString {- ^ target triple -} ->
  Maybe (IO ()) {- ^ called on compilation errors -} ->
  IO JITCompileCallbackManager
newJITCompileCallbackManager :: ExecutionSession
-> ShortByteString -> Maybe (IO ()) -> IO JITCompileCallbackManager
newJITCompileCallbackManager (ExecutionSession es :: Ptr ExecutionSession
es) triple :: ShortByteString
triple errorHandler :: Maybe (IO ())
errorHandler = (AnyContT IO JITCompileCallbackManager
 -> (JITCompileCallbackManager -> IO JITCompileCallbackManager)
 -> IO JITCompileCallbackManager)
-> (JITCompileCallbackManager -> IO JITCompileCallbackManager)
-> AnyContT IO JITCompileCallbackManager
-> IO JITCompileCallbackManager
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO JITCompileCallbackManager
-> (JITCompileCallbackManager -> IO JITCompileCallbackManager)
-> IO JITCompileCallbackManager
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT JITCompileCallbackManager -> IO JITCompileCallbackManager
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO JITCompileCallbackManager
 -> IO JITCompileCallbackManager)
-> AnyContT IO JITCompileCallbackManager
-> IO JITCompileCallbackManager
forall a b. (a -> b) -> a -> b
$ do
  CString
triple' <- ShortByteString -> AnyContT IO CString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM ShortByteString
triple
  (errorHandler' :: TargetAddress
errorHandler', cleanup :: IO ()
cleanup) <- Maybe (IO ()) -> AnyContT IO (TargetAddress, IO ())
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Maybe (IO ())
errorHandler
  Ptr JITCompileCallbackManager
callbackMgr <- IO (Ptr JITCompileCallbackManager)
-> AnyContT IO (Ptr JITCompileCallbackManager)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr ExecutionSession
-> CString -> TargetAddress -> IO (Ptr JITCompileCallbackManager)
FFI.createLocalCompileCallbackManager Ptr ExecutionSession
es CString
triple' TargetAddress
errorHandler')
  JITCompileCallbackManager -> AnyContT IO JITCompileCallbackManager
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr JITCompileCallbackManager -> IO () -> JITCompileCallbackManager
CallbackMgr Ptr JITCompileCallbackManager
callbackMgr IO ()
cleanup)

-- | Dispose of a 'JITCompileCallbackManager'.
disposeJITCompileCallbackManager :: JITCompileCallbackManager -> IO ()
disposeJITCompileCallbackManager :: JITCompileCallbackManager -> IO ()
disposeJITCompileCallbackManager (CallbackMgr mgr :: Ptr JITCompileCallbackManager
mgr cleanup :: IO ()
cleanup) =
  Ptr JITCompileCallbackManager -> IO ()
FFI.disposeCallbackManager Ptr JITCompileCallbackManager
mgr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
cleanup

-- | Execute a computation using a new 'JITCompileCallbackManager'.
withJITCompileCallbackManager ::
  ExecutionSession ->
  ShortByteString {- ^ target triple -} ->
  Maybe (IO ()) {- ^ called on compilation errors -} ->
  (JITCompileCallbackManager -> IO a) ->
  IO a
withJITCompileCallbackManager :: ExecutionSession
-> ShortByteString
-> Maybe (IO ())
-> (JITCompileCallbackManager -> IO a)
-> IO a
withJITCompileCallbackManager es :: ExecutionSession
es triple :: ShortByteString
triple errorHandler :: Maybe (IO ())
errorHandler =
  IO JITCompileCallbackManager
-> (JITCompileCallbackManager -> IO ())
-> (JITCompileCallbackManager -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (ExecutionSession
-> ShortByteString -> Maybe (IO ()) -> IO JITCompileCallbackManager
newJITCompileCallbackManager ExecutionSession
es ShortByteString
triple Maybe (IO ())
errorHandler)
    JITCompileCallbackManager -> IO ()
disposeJITCompileCallbackManager

-- | Create a new 'CompileOnDemandLayer'. The partitioning function
-- specifies which functions should be compiled when a function is
-- called.
--
-- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer'.
newCompileOnDemandLayer :: CompileLayer l =>
  ExecutionSession ->
  l ->
  TargetMachine ->
  (ModuleKey -> IO (Ptr FFI.SymbolResolver)) ->
  (ModuleKey -> Ptr FFI.SymbolResolver -> IO ()) ->
  (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} ->
  JITCompileCallbackManager ->
  IndirectStubsManagerBuilder ->
  Bool {- ^ clone stubs into partitions -} ->
  IO (CompileOnDemandLayer l)
newCompileOnDemandLayer :: ExecutionSession
-> l
-> TargetMachine
-> (ModuleKey -> IO (Ptr SymbolResolver))
-> (ModuleKey -> Ptr SymbolResolver -> IO ())
-> PartitioningFn
-> JITCompileCallbackManager
-> IndirectStubsManagerBuilder
-> Bool
-> IO (CompileOnDemandLayer l)
newCompileOnDemandLayer (ExecutionSession es :: Ptr ExecutionSession
es) baseLayer :: l
baseLayer tm :: TargetMachine
tm getSymbolResolver :: ModuleKey -> IO (Ptr SymbolResolver)
getSymbolResolver setSymbolResolver :: ModuleKey -> Ptr SymbolResolver -> IO ()
setSymbolResolver partition :: PartitioningFn
partition (CallbackMgr callbackMgr :: Ptr JITCompileCallbackManager
callbackMgr _) (StubsMgr stubsMgr :: Ptr IndirectStubsManagerBuilder
stubsMgr) cloneStubs :: Bool
cloneStubs =
  (AnyContT IO (CompileOnDemandLayer l)
 -> (CompileOnDemandLayer l -> IO (CompileOnDemandLayer l))
 -> IO (CompileOnDemandLayer l))
-> (CompileOnDemandLayer l -> IO (CompileOnDemandLayer l))
-> AnyContT IO (CompileOnDemandLayer l)
-> IO (CompileOnDemandLayer l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO (CompileOnDemandLayer l)
-> (CompileOnDemandLayer l -> IO (CompileOnDemandLayer l))
-> IO (CompileOnDemandLayer l)
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT CompileOnDemandLayer l -> IO (CompileOnDemandLayer l)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO (CompileOnDemandLayer l)
 -> IO (CompileOnDemandLayer l))
-> AnyContT IO (CompileOnDemandLayer l)
-> IO (CompileOnDemandLayer l)
forall a b. (a -> b) -> a -> b
$ do
    IORef [IO ()]
cleanups <- IO (IORef [IO ()]) -> AnyContT IO (IORef [IO ()])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef [])
    Ptr DataLayout
dl <- TargetMachine -> IORef [IO ()] -> AnyContT IO (Ptr DataLayout)
forall (m :: * -> *).
MonadAnyCont IO m =>
TargetMachine -> IORef [IO ()] -> m (Ptr DataLayout)
createRegisteredDataLayout TargetMachine
tm IORef [IO ()]
cleanups
    FunPtr (ModuleKey -> IO (Ptr SymbolResolver))
getSymbolResolver' <- IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver)))
-> AnyContT IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef [IO ()]
-> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver)))
-> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver)))
forall a. IORef [IO ()] -> IO (FunPtr a) -> IO (FunPtr a)
allocFunPtr IORef [IO ()]
cleanups ((ModuleKey -> IO (Ptr SymbolResolver))
-> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver)))
FFI.wrapGetSymbolResolver ModuleKey -> IO (Ptr SymbolResolver)
getSymbolResolver))
    FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())
setSymbolResolver' <- IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()))
-> AnyContT IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef [IO ()]
-> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()))
-> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()))
forall a. IORef [IO ()] -> IO (FunPtr a) -> IO (FunPtr a)
allocFunPtr IORef [IO ()]
cleanups ((ModuleKey -> Ptr SymbolResolver -> IO ())
-> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()))
FFI.wrapSetSymbolResolver ModuleKey -> Ptr SymbolResolver -> IO ()
setSymbolResolver))
    IORef [IO ()] -> IO (FunPtr PartitioningFn)
partitionAct <- PartitioningFn
-> AnyContT IO (IORef [IO ()] -> IO (FunPtr PartitioningFn))
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM PartitioningFn
partition
    FunPtr PartitioningFn
partition' <- IO (FunPtr PartitioningFn) -> AnyContT IO (FunPtr PartitioningFn)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr PartitioningFn) -> AnyContT IO (FunPtr PartitioningFn))
-> IO (FunPtr PartitioningFn)
-> AnyContT IO (FunPtr PartitioningFn)
forall a b. (a -> b) -> a -> b
$ IORef [IO ()] -> IO (FunPtr PartitioningFn)
partitionAct IORef [IO ()]
cleanups
    LLVMBool
cloneStubs' <- Bool -> AnyContT IO LLVMBool
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM Bool
cloneStubs
    Ptr CompileOnDemandLayer
cl <-
      IO (Ptr CompileOnDemandLayer)
-> AnyContT IO (Ptr CompileOnDemandLayer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (Ptr ExecutionSession
-> Ptr CompileLayer
-> FunPtr (ModuleKey -> IO (Ptr SymbolResolver))
-> FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())
-> FunPtr PartitioningFn
-> Ptr JITCompileCallbackManager
-> Ptr IndirectStubsManagerBuilder
-> LLVMBool
-> IO (Ptr CompileOnDemandLayer)
FFI.createCompileOnDemandLayer
           Ptr ExecutionSession
es
           (l -> Ptr CompileLayer
forall l. CompileLayer l => l -> Ptr CompileLayer
getCompileLayer l
baseLayer)
           FunPtr (ModuleKey -> IO (Ptr SymbolResolver))
getSymbolResolver'
           FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())
setSymbolResolver'
           FunPtr PartitioningFn
partition'
           Ptr JITCompileCallbackManager
callbackMgr
           Ptr IndirectStubsManagerBuilder
stubsMgr
           LLVMBool
cloneStubs')
    CompileOnDemandLayer l -> AnyContT IO (CompileOnDemandLayer l)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CompileOnDemandLayer
-> Ptr DataLayout -> IORef [IO ()] -> CompileOnDemandLayer l
forall baseLayer.
Ptr CompileOnDemandLayer
-> Ptr DataLayout
-> IORef [IO ()]
-> CompileOnDemandLayer baseLayer
CompileOnDemandLayer Ptr CompileOnDemandLayer
cl Ptr DataLayout
dl IORef [IO ()]
cleanups)

-- | 'bracket'-style wrapper around 'newCompileOnDemandLayer' and 'disposeCompileLayer'.
withCompileOnDemandLayer ::
  CompileLayer l =>
  ExecutionSession ->
  l ->
  TargetMachine ->
  (ModuleKey -> IO (Ptr FFI.SymbolResolver)) ->
  (ModuleKey -> Ptr FFI.SymbolResolver -> IO ()) ->
  (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} ->
  JITCompileCallbackManager ->
  IndirectStubsManagerBuilder ->
  Bool {- ^ clone stubs into partitions -} ->
  (CompileOnDemandLayer l -> IO a) ->
  IO a
withCompileOnDemandLayer :: ExecutionSession
-> l
-> TargetMachine
-> (ModuleKey -> IO (Ptr SymbolResolver))
-> (ModuleKey -> Ptr SymbolResolver -> IO ())
-> PartitioningFn
-> JITCompileCallbackManager
-> IndirectStubsManagerBuilder
-> Bool
-> (CompileOnDemandLayer l -> IO a)
-> IO a
withCompileOnDemandLayer es :: ExecutionSession
es l :: l
l tm :: TargetMachine
tm getSymbolResolver :: ModuleKey -> IO (Ptr SymbolResolver)
getSymbolResolver setSymbolResolver :: ModuleKey -> Ptr SymbolResolver -> IO ()
setSymbolResolver partition :: PartitioningFn
partition callbackMgr :: JITCompileCallbackManager
callbackMgr stubsMgr :: IndirectStubsManagerBuilder
stubsMgr cloneStubs :: Bool
cloneStubs =
  IO (CompileOnDemandLayer l)
-> (CompileOnDemandLayer l -> IO ())
-> (CompileOnDemandLayer l -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (ExecutionSession
-> l
-> TargetMachine
-> (ModuleKey -> IO (Ptr SymbolResolver))
-> (ModuleKey -> Ptr SymbolResolver -> IO ())
-> PartitioningFn
-> JITCompileCallbackManager
-> IndirectStubsManagerBuilder
-> Bool
-> IO (CompileOnDemandLayer l)
forall l.
CompileLayer l =>
ExecutionSession
-> l
-> TargetMachine
-> (ModuleKey -> IO (Ptr SymbolResolver))
-> (ModuleKey -> Ptr SymbolResolver -> IO ())
-> PartitioningFn
-> JITCompileCallbackManager
-> IndirectStubsManagerBuilder
-> Bool
-> IO (CompileOnDemandLayer l)
newCompileOnDemandLayer ExecutionSession
es l
l TargetMachine
tm ModuleKey -> IO (Ptr SymbolResolver)
getSymbolResolver ModuleKey -> Ptr SymbolResolver -> IO ()
setSymbolResolver PartitioningFn
partition JITCompileCallbackManager
callbackMgr IndirectStubsManagerBuilder
stubsMgr Bool
cloneStubs)
    CompileOnDemandLayer l -> IO ()
forall l. CompileLayer l => l -> IO ()
disposeCompileLayer