[project @ 2004-02-25 19:21:20 by krasimir]

Added finalizeForeignPtr function

diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs
index 515c0d8..b2c1406 100644 (file)
--- a/Foreign/ForeignPtr.hs
+++ b/Foreign/ForeignPtr.hs
@@ -33,6 +33,10 @@ module Foreign.ForeignPtr
 #endif
        , withForeignPtr
 
+#ifdef __GLASGOW_HASKELL__
+       , finalizeForeignPtr
+#endif
+
        -- ** Low-level operations
        , unsafeForeignPtrToPtr
        , touchForeignPtr

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index 216f578..43f9ac7 100644 (file)
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -26,6 +26,7 @@ module GHC.ForeignPtr
        castForeignPtr,
        newConcForeignPtr,
        addForeignPtrConcFinalizer,
+       finalizeForeignPtr
   ) where
 
 import Control.Monad   ( sequence_ )
@@ -230,3 +231,15 @@ castForeignPtr :: ForeignPtr a -> ForeignPtr b
 -- ^This function casts a 'ForeignPtr'
 -- parameterised by one type into another type.
 castForeignPtr f = unsafeCoerce# f
+
+-- | Causes a the finalizers associated with a foreign pointer to be run
+-- immediately.
+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