module LLVM.Internal.OrcJIT.IRCompileLayer where

import LLVM.Prelude

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

import qualified LLVM.Internal.FFI.DataLayout as FFI
import qualified LLVM.Internal.FFI.OrcJIT.CompileLayer as FFI
import qualified LLVM.Internal.FFI.OrcJIT.IRCompileLayer as FFI
import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import LLVM.Internal.OrcJIT
import LLVM.Internal.OrcJIT.CompileLayer
import LLVM.Internal.OrcJIT.LinkingLayer (LinkingLayer(..), getLinkingLayer)
import LLVM.Internal.Target

-- | 'IRCompileLayer' compiles modules immediately when they are
-- added. It parametrized by a 'LinkingLayer' which handles linking of
-- the generated object files.
data IRCompileLayer linkingLayer =
  IRCompileLayer {
    IRCompileLayer linkingLayer -> Ptr IRCompileLayer
compileLayer :: !(Ptr FFI.IRCompileLayer),
    IRCompileLayer linkingLayer -> Ptr DataLayout
dataLayout :: !(Ptr FFI.DataLayout),
    IRCompileLayer linkingLayer -> IORef [IO ()]
cleanupActions :: !(IORef [IO ()])
  }
  deriving IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
(IRCompileLayer linkingLayer
 -> IRCompileLayer linkingLayer -> Bool)
-> (IRCompileLayer linkingLayer
    -> IRCompileLayer linkingLayer -> Bool)
-> Eq (IRCompileLayer linkingLayer)
forall linkingLayer.
IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
$c/= :: forall linkingLayer.
IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
== :: IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
$c== :: forall linkingLayer.
IRCompileLayer linkingLayer -> IRCompileLayer linkingLayer -> Bool
Eq

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

-- | Create a new 'IRCompileLayer'.
--
-- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer.
newIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> IO (IRCompileLayer l)
newIRCompileLayer :: l -> TargetMachine -> IO (IRCompileLayer l)
newIRCompileLayer linkingLayer :: l
linkingLayer (TargetMachine tm :: Ptr TargetMachine
tm) = (AnyContT IO (IRCompileLayer l)
 -> (IRCompileLayer l -> IO (IRCompileLayer l))
 -> IO (IRCompileLayer l))
-> (IRCompileLayer l -> IO (IRCompileLayer l))
-> AnyContT IO (IRCompileLayer l)
-> IO (IRCompileLayer l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO (IRCompileLayer l)
-> (IRCompileLayer l -> IO (IRCompileLayer l))
-> IO (IRCompileLayer l)
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT IRCompileLayer l -> IO (IRCompileLayer l)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO (IRCompileLayer l) -> IO (IRCompileLayer l))
-> AnyContT IO (IRCompileLayer l) -> IO (IRCompileLayer 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 (Ptr TargetMachine -> TargetMachine
TargetMachine Ptr TargetMachine
tm) IORef [IO ()]
cleanups
  Ptr IRCompileLayer
cl <- (forall r. (Ptr IRCompileLayer -> IO r) -> IO r)
-> AnyContT IO (Ptr IRCompileLayer)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Ptr IRCompileLayer -> IO r) -> IO r)
 -> AnyContT IO (Ptr IRCompileLayer))
-> (forall r. (Ptr IRCompileLayer -> IO r) -> IO r)
-> AnyContT IO (Ptr IRCompileLayer)
forall a b. (a -> b) -> a -> b
$
    IO (Ptr IRCompileLayer)
-> (Ptr IRCompileLayer -> IO ())
-> (Ptr IRCompileLayer -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
      (Ptr LinkingLayer -> Ptr TargetMachine -> IO (Ptr IRCompileLayer)
FFI.createIRCompileLayer (l -> Ptr LinkingLayer
forall l. LinkingLayer l => l -> Ptr LinkingLayer
getLinkingLayer l
linkingLayer) Ptr TargetMachine
tm)
      (Ptr CompileLayer -> IO ()
FFI.disposeCompileLayer (Ptr CompileLayer -> IO ())
-> (Ptr IRCompileLayer -> Ptr CompileLayer)
-> Ptr IRCompileLayer
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr IRCompileLayer -> Ptr CompileLayer
forall a b. DescendentOf a b => Ptr b -> Ptr a
FFI.upCast)
  IRCompileLayer l -> AnyContT IO (IRCompileLayer l)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr IRCompileLayer
-> Ptr DataLayout -> IORef [IO ()] -> IRCompileLayer l
forall linkingLayer.
Ptr IRCompileLayer
-> Ptr DataLayout -> IORef [IO ()] -> IRCompileLayer linkingLayer
IRCompileLayer Ptr IRCompileLayer
cl Ptr DataLayout
dl IORef [IO ()]
cleanups)

-- | 'bracket'-style wrapper around 'newIRCompileLayer' and 'disposeCompileLayer'.
withIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> (IRCompileLayer l -> IO a) -> IO a
withIRCompileLayer :: l -> TargetMachine -> (IRCompileLayer l -> IO a) -> IO a
withIRCompileLayer linkingLayer :: l
linkingLayer tm :: TargetMachine
tm =
  IO (IRCompileLayer l)
-> (IRCompileLayer l -> IO ())
-> (IRCompileLayer l -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (l -> TargetMachine -> IO (IRCompileLayer l)
forall l.
LinkingLayer l =>
l -> TargetMachine -> IO (IRCompileLayer l)
newIRCompileLayer l
linkingLayer TargetMachine
tm) IRCompileLayer l -> IO ()
forall l. CompileLayer l => l -> IO ()
disposeCompileLayer