{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}

#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.STM.TVar
-- Copyright   :  (c) The University of Glasgow 2004
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- TVar: Transactional variables
--
-----------------------------------------------------------------------------

module Control.Concurrent.STM.TVar (
        -- * TVars
        TVar,
        newTVar,
        newTVarIO,
        readTVar,
        readTVarIO,
        writeTVar,
        modifyTVar,
        modifyTVar',
        stateTVar,
        swapTVar,
#ifdef __GLASGOW_HASKELL__
        registerDelay,
#endif
        mkWeakTVar
  ) where

#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.Conc
import GHC.Weak
#else
import Control.Sequential.STM
#endif

-- Like 'modifyIORef' but for 'TVar'.
-- | Mutate the contents of a 'TVar'. /N.B./, this version is
-- non-strict.
--
-- @since 2.3
modifyTVar :: TVar a -> (a -> a) -> STM ()
modifyTVar :: forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar a
var a -> a
f = do
    x <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
var
    writeTVar var (f x)
{-# INLINE modifyTVar #-}


-- | Strict version of 'modifyTVar'.
--
-- @since 2.3
modifyTVar' :: TVar a -> (a -> a) -> STM ()
modifyTVar' :: forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar a
var a -> a
f = do
    x <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
var
    writeTVar var $! f x
{-# INLINE modifyTVar' #-}


-- | Like 'modifyTVar'' but the function is a simple state transition that can
-- return a side value which is passed on as the result of the 'STM'.
--
-- @since 2.5.0
stateTVar :: TVar s -> (s -> (a, s)) -> STM a
stateTVar :: forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar s
var s -> (a, s)
f = do
   s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
var
   let !(a, s') = f s
   writeTVar var s'
   return a
{-# INLINE stateTVar #-}


-- Like 'swapTMVar' but for 'TVar'.
-- | Swap the contents of a 'TVar' for a new value.
--
-- @since 2.3
swapTVar :: TVar a -> a -> STM a
swapTVar :: forall a. TVar a -> a -> STM a
swapTVar TVar a
var a
new = do
    old <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
var
    writeTVar var new
    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
--
-- @since 2.4.3
mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a))
mkWeakTVar :: forall a. TVar a -> IO () -> IO (Weak (TVar a))
mkWeakTVar t :: TVar a
t@(TVar TVar# RealWorld a
t#) (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer) = (State# RealWorld -> (# State# RealWorld, Weak (TVar a) #))
-> IO (Weak (TVar a))
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Weak (TVar a) #))
 -> IO (Weak (TVar a)))
-> (State# RealWorld -> (# State# RealWorld, Weak (TVar a) #))
-> IO (Weak (TVar a))
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case TVar# RealWorld a
-> TVar a
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, Weak# (TVar a) #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# TVar# RealWorld a
t# TVar a
t State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of (# State# RealWorld
s1, Weak# (TVar a)
w #) -> (# State# RealWorld
s1, Weak# (TVar a) -> Weak (TVar a)
forall v. Weak# v -> Weak v
Weak Weak# (TVar a)
w #)