ForeignPtr.hs

{-# LANGUAGE ForeignFunctionInterface #-}
module LLVM.Extra.ForeignPtr (
   newInit, newParam,
   new, with,
   ) where

import qualified LLVM.Extra.Memory as Memory
import LLVM.Extra.Class (MakeValueTuple, )

import qualified Foreign.Marshal.Utils as Marshal
import qualified Foreign.ForeignPtr as FPtr
import qualified Foreign.Concurrent as FC
import Foreign.Storable (Storable, poke, )
import Foreign.Ptr (Ptr, FunPtr, )


type Importer f = FunPtr f -> f

foreign import ccall safe "dynamic" derefStartPtr ::
   Importer (IO (Ptr a))

newInit ::
   FunPtr (Ptr a -> IO ()) ->
   FunPtr (IO (Ptr a)) ->
   IO (FPtr.ForeignPtr a)
newInit stop start =
   FPtr.newForeignPtr stop =<< derefStartPtr start


foreign import ccall safe "dynamic" derefStartParamPtr ::
   Importer (Ptr b -> IO (Ptr a))

{-
We cannot use 'bracket' when constructing lazy StorableVector,
since this would mean that the temporary memory is freed immediately.
Instead we must add a Finalizer to the ForeignPtr.
-}
newParam ::
   (Storable b, MakeValueTuple b bl, Memory.C bl bp) =>
   FunPtr (Ptr a -> IO ()) ->
   FunPtr (Ptr bp -> IO (Ptr a)) ->
   b -> IO (FPtr.ForeignPtr a)
newParam stop start b =
   FPtr.newForeignPtr stop =<<
   Marshal.with b (derefStartParamPtr start . Memory.castStorablePtr)

{-
requires (Storable ap) constraint
and we have no Storable instance for Struct

new ::
   (Storable a, MakeValueTuple a al, Memory.C al ap) =>
   a -> IO (FPtr.ForeignPtr ap)
new a = do
   ptr <- FPtr.mallocForeignPtr
   FPtr.withForeignPtr ptr (flip poke a . castPtr)
   return ptr
-}

{- |
Adding the finalizer to a ForeignPtr seems to be the only way
that warrants execution of the finalizer (not too early and not never).
However, the normal ForeignPtr finalizers must be independent from Haskell runtime.
In contrast to ForeignPtr finalizers,
addFinalizer adds finalizers to boxes, that are optimized away.
Thus finalizers are run too early or not at all.
Concurrent.ForeignPtr and using threaded execution
is the only way to get finalizers in Haskell IO.
-}
new ::
   Storable a =>
   IO () ->
   a -> IO (FPtr.ForeignPtr a)
new finalizer a = do
   ptr <- FPtr.mallocForeignPtr
   FC.addForeignPtrFinalizer ptr finalizer
   FPtr.withForeignPtr ptr (flip poke a)
   return ptr

with ::
   (Storable a, MakeValueTuple a al, Memory.C al ap) =>
   FPtr.ForeignPtr a -> (Ptr ap -> IO b) -> IO b
with fp func =
   FPtr.withForeignPtr fp (func . Memory.castStorablePtr)