[ forwarded to [EMAIL PROTECTED] ]

>    In the current implementation there is no way to
> force finalization of the foreign ptr if there are 
> still references to it. In this scenario
> the finalization will be executed during the next 
> garbage collection. In some cases it is known that the
> foreign pointer value is not used anymore but the
> references still exist in the stack and they cannot be
> freed from the collector. In such cases I want to be
> able to explicitly finalize the foreign pointers. For
> that reason I wrote the following simple function:
> 
> module FinalizeForeignPtr(finalizeForeignPtr) where
> 
> import GHC.ForeignPtr
> import Data.IORef
> 
> finalizeForeignPtr :: ForeignPtr a -> IO ()
> finalizeForeignPtr foreignPtr = do
>       finalizers <- readIORef refFinalizers
>       sequence_ finalizers
>       writeIORef refFinalizers []
>       where
>               refFinalizers = case foreignPtr of
>                       (ForeignPtr _ ref) -> ref
>                       (MallocPtr  _ ref) -> ref

There's a race condition between multiple finalizeForeignPtrs, but apart
from that it looks fine.

I don't see any reason why we shouldn't have this.  GHC's weak pointer
interface has a similar function for running the finalizer early.

Cheers,
        Simon
_______________________________________________
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
_______________________________________________
FFI mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/ffi

Reply via email to