Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b8df01cbaeb2203834a26838be18c9ca372c5881 >--------------------------------------------------------------- commit b8df01cbaeb2203834a26838be18c9ca372c5881 Author: Simon Marlow <[email protected]> Date: Mon Jun 4 10:34:30 2012 +0100 add mkWeakMVar; deprecate addMVarFinalizer (#6130) >--------------------------------------------------------------- Control/Concurrent/MVar.hs | 19 ++++++++++++++++--- 1 files changed, 16 insertions(+), 3 deletions(-) diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs index c407306..1e1a9ce 100644 --- a/Control/Concurrent/MVar.hs +++ b/Control/Concurrent/MVar.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, UnboxedTuples, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -138,6 +138,7 @@ module Control.Concurrent.MVar , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO () , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b #ifndef __HUGS__ + , mkWeakMVar , addMVarFinalizer -- :: MVar a -> IO () -> IO () #endif ) where @@ -149,9 +150,11 @@ import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, #endif #ifdef __GLASGOW_HASKELL__ -import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, - tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer +import GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar, + tryTakeMVar, tryPutMVar, isEmptyMVar ) +import qualified GHC.MVar +import GHC.Weak #endif #ifdef __GLASGOW_HASKELL__ @@ -232,3 +235,13 @@ modifyMVar m io = (a',b) <- restore (io a) `onException` putMVar m a putMVar m a' return b + +{-# DEPRECATED addMVarFinalizer "use mkWeakMVar instead" #-} +addMVarFinalizer :: MVar a -> IO () -> IO () +addMVarFinalizer = GHC.MVar.addMVarFinalizer + +-- | Make a 'Weak' pointer to an 'MVar', using the second argument as +-- a finalizer to run when 'MVar' is garbage-collected +mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a)) +mkWeakMVar m@(MVar m#) f = IO $ \s -> + case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
