{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Synthesizer.LLVM.ForeignPtr where
import qualified LLVM.DSL.Execution as Exec
import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.ExecutionEngine as EE
import qualified LLVM.Core as LLVM
import qualified Foreign.ForeignPtr as FPtr
import qualified Foreign.Concurrent as FC
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.StablePtr (newStablePtr, freeStablePtr)
import Foreign.Ptr (nullPtr)
newAux :: IO () -> IO (ForeignPtr ())
newAux :: IO () -> IO (ForeignPtr ())
newAux = Ptr () -> IO () -> IO (ForeignPtr ())
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
FC.newForeignPtr Ptr ()
forall a. Ptr a
nullPtr
makeFinalizer :: (EE.ExecutionEngine, IO ()) -> IO (IO ())
makeFinalizer :: (ExecutionEngine, IO ()) -> IO (IO ())
makeFinalizer (ExecutionEngine
ee, IO ()
finalizer) = do
StablePtr ExecutionEngine
stable <- ExecutionEngine -> IO (StablePtr ExecutionEngine)
forall a. a -> IO (StablePtr a)
newStablePtr ExecutionEngine
ee
IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ IO ()
finalizer IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StablePtr ExecutionEngine -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr ExecutionEngine
stable
type MemoryPtr struct = ForeignPtr (EE.Stored struct)
newInit :: Exec.Finalizer a -> IO (LLVM.Ptr a) -> IO (MemoryPtr a)
newInit :: forall a. Finalizer a -> IO (Ptr a) -> IO (MemoryPtr a)
newInit (ExecutionEngine
ee, Ptr a -> IO ()
stop) IO (Ptr a)
start = do
Ptr a
state <- IO (Ptr a)
start
Ptr (Stored a) -> IO () -> IO (MemoryPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
FC.newForeignPtr (Ptr a -> Ptr (Stored a)
forall a. Ptr a -> Ptr (Stored a)
EE.castToStoredPtr Ptr a
state)
(IO () -> IO (MemoryPtr a)) -> IO (IO ()) -> IO (MemoryPtr a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExecutionEngine, IO ()) -> IO (IO ())
makeFinalizer (ExecutionEngine
ee, Ptr a -> IO ()
stop Ptr a
state)
newParam ::
(Marshal.C b) =>
Exec.Finalizer a ->
(LLVM.Ptr (Marshal.Struct b) -> IO (LLVM.Ptr a)) ->
b -> IO (MemoryPtr a)
newParam :: forall b a.
C b =>
Finalizer a
-> (Ptr (Struct b) -> IO (Ptr a)) -> b -> IO (MemoryPtr a)
newParam Finalizer a
stop Ptr (Struct b) -> IO (Ptr a)
start b
b =
Finalizer a -> IO (Ptr a) -> IO (MemoryPtr a)
forall a. Finalizer a -> IO (Ptr a) -> IO (MemoryPtr a)
newInit Finalizer a
stop (b -> (Ptr (Struct b) -> IO (Ptr a)) -> IO (Ptr a)
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
Marshal.with b
b Ptr (Struct b) -> IO (Ptr a)
start)
newParamMV ::
(MarshalMV.C b) =>
Exec.Finalizer a ->
(LLVM.Ptr (MarshalMV.Struct b) -> IO (LLVM.Ptr a)) ->
b -> IO (MemoryPtr a)
newParamMV :: forall b a.
C b =>
Finalizer a
-> (Ptr (Struct b) -> IO (Ptr a)) -> b -> IO (MemoryPtr a)
newParamMV Finalizer a
stop Ptr (Struct b) -> IO (Ptr a)
start b
b =
Finalizer a -> IO (Ptr a) -> IO (MemoryPtr a)
forall a. Finalizer a -> IO (Ptr a) -> IO (MemoryPtr a)
newInit Finalizer a
stop (b -> (Ptr (Struct b) -> IO (Ptr a)) -> IO (Ptr a)
forall a b. C a => a -> (Ptr (Struct a) -> IO b) -> IO b
MarshalMV.with b
b Ptr (Struct b) -> IO (Ptr a)
start)
new ::
(Marshal.C a, Marshal.Struct a ~ struct) =>
IO () -> a -> IO (MemoryPtr struct)
new :: forall a struct.
(C a, Struct a ~ struct) =>
IO () -> a -> IO (MemoryPtr struct)
new IO ()
finalizer a
a = do
MemoryPtr struct
ptr <- IO (MemoryPtr struct)
forall a. Storable a => IO (ForeignPtr a)
FPtr.mallocForeignPtr
MemoryPtr struct -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
FC.addForeignPtrFinalizer MemoryPtr struct
ptr IO ()
finalizer
MemoryPtr struct -> (Ptr struct -> IO ()) -> IO ()
forall struct a. MemoryPtr struct -> (Ptr struct -> IO a) -> IO a
with MemoryPtr struct
ptr ((Ptr struct -> IO ()) -> IO ()) -> (Ptr struct -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr struct -> a -> IO ()) -> a -> Ptr struct -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr struct -> a -> IO ()
forall a struct.
(C a, Struct a ~ struct, Marshal struct) =>
Ptr struct -> a -> IO ()
Marshal.poke a
a
MemoryPtr struct -> IO (MemoryPtr struct)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryPtr struct
ptr
with :: MemoryPtr struct -> (LLVM.Ptr struct -> IO a) -> IO a
with :: forall struct a. MemoryPtr struct -> (Ptr struct -> IO a) -> IO a
with MemoryPtr struct
fptr Ptr struct -> IO a
act = MemoryPtr struct -> (Ptr (Stored struct) -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr MemoryPtr struct
fptr ((Ptr (Stored struct) -> IO a) -> IO a)
-> (Ptr (Stored struct) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr struct -> IO a
act (Ptr struct -> IO a)
-> (Ptr (Stored struct) -> Ptr struct)
-> Ptr (Stored struct)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Stored struct) -> Ptr struct
forall a. Ptr (Stored a) -> Ptr a
EE.castFromStoredPtr