[commit: packages/stm] master: add mkWeakTVar (#7991) (3465b0f)

[git at git.haskell.org]

Repository : ssh://git at git.haskell.org/stm

On branch  : master
Link       : http://git.haskell.org/packages/stm.git/commitdiff/3465b0fe63e96266acdb78ba8e2c6a209f99a117

>---------------------------------------------------------------

commit 3465b0fe63e96266acdb78ba8e2c6a209f99a117
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Sep 27 02:09:25 2013 +0100

    add mkWeakTVar (#7991)


>---------------------------------------------------------------

3465b0fe63e96266acdb78ba8e2c6a209f99a117
 Control/Concurrent/STM/TVar.hs |   13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs
index de9b85a..d15896b 100644
--- a/Control/Concurrent/STM/TVar.hs
+++ b/Control/Concurrent/STM/TVar.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
@@ -30,12 +30,15 @@ module Control.Concurrent.STM.TVar (
 	modifyTVar',
 	swapTVar,
 #ifdef __GLASGOW_HASKELL__
-	registerDelay
+        registerDelay,
 #endif
+        mkWeakTVar
   ) where
 
 #ifdef __GLASGOW_HASKELL__
+import GHC.Base
 import GHC.Conc
+import GHC.Weak
 #else
 import Control.Sequential.STM
 #endif
@@ -72,3 +75,9 @@ swapTVar var new = do
     return old
 {-# INLINE swapTVar #-}
 
+
+-- | Make a 'Weak' pointer to a 'TVar', using the second argument as
+-- a finalizer to run when 'TVar' is garbage-collected
+mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a))
+mkWeakTVar t@(TVar t#) f = IO $ \s ->
+    case mkWeak# t# t f s of (# s1, w #) -> (# s1, Weak w #)