{-# 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 = FC.newForeignPtr nullPtr
makeFinalizer :: (EE.ExecutionEngine, IO ()) -> IO (IO ())
makeFinalizer (ee, finalizer) = do
stable <- newStablePtr ee
return $ finalizer >> freeStablePtr stable
type MemoryPtr struct = ForeignPtr (EE.Stored struct)
newInit :: Exec.Finalizer a -> IO (LLVM.Ptr a) -> IO (MemoryPtr a)
newInit (ee, stop) start = do
state <- start
FC.newForeignPtr (EE.castToStoredPtr state)
=<< makeFinalizer (ee, stop state)
newParam ::
(Marshal.C b) =>
Exec.Finalizer a ->
(LLVM.Ptr (Marshal.Struct b) -> IO (LLVM.Ptr a)) ->
b -> IO (MemoryPtr a)
newParam stop start b =
newInit stop (Marshal.with b start)
newParamMV ::
(MarshalMV.C b) =>
Exec.Finalizer a ->
(LLVM.Ptr (MarshalMV.Struct b) -> IO (LLVM.Ptr a)) ->
b -> IO (MemoryPtr a)
newParamMV stop start b =
newInit stop (MarshalMV.with b start)
new ::
(Marshal.C a, Marshal.Struct a ~ struct) =>
IO () -> a -> IO (MemoryPtr struct)
new finalizer a = do
ptr <- FPtr.mallocForeignPtr
FC.addForeignPtrFinalizer ptr finalizer
with ptr $ flip Marshal.poke a
return ptr
with :: MemoryPtr struct -> (LLVM.Ptr struct -> IO a) -> IO a
with fptr act = withForeignPtr fptr $ act . EE.castFromStoredPtr