From: krasimir <unknown>
Date: Wed, 25 Feb 2004 19:21:21 +0000 (+0000)
Subject: [project @ 2004-02-25 19:21:20 by krasimir]
X-Git-Tag: nhc98-1-18-release~366
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=baa850fd3b6c2b277492e35cddfe2c46f1eead2c;p=ghc-base.git

[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
--- 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
--- 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