{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.IORef
-- Copyright   :  (c) The University of Glasgow 2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  ghc-devs@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The IORef type
--
-----------------------------------------------------------------------------

module GHC.Internal.IORef (
        IORef(..),
        newIORef, readIORef, writeIORef, atomicModifyIORef2Lazy,
        atomicModifyIORef2, atomicModifyIORefLazy_, atomicModifyIORef'_,
        atomicModifyIORefP, atomicSwapIORef, atomicModifyIORef'
    ) where

import GHC.Internal.Base
import GHC.Internal.STRef
import GHC.Internal.IO

-- ---------------------------------------------------------------------------
-- IORefs

-- |A mutable variable in the 'IO' monad.
--
-- >>> import GHC.Internal.Data.IORef
-- >>> r <- newIORef 0
-- >>> readIORef r
-- 0
-- >>> writeIORef r 1
-- >>> readIORef r
-- 1
-- >>> atomicWriteIORef r 2
-- >>> readIORef r
-- 2
-- >>> modifyIORef' r (+ 1)
-- >>> readIORef r
-- 3
-- >>> atomicModifyIORef' r (\a -> (a + 1, ()))
-- >>> readIORef r
-- 4
--
-- See also 'Data.STRef.STRef' and 'Control.Concurrent.MVar.MVar'.
--
newtype IORef a = IORef (STRef RealWorld a)
  deriving IORef a -> IORef a -> Bool
(IORef a -> IORef a -> Bool)
-> (IORef a -> IORef a -> Bool) -> Eq (IORef a)
forall a. IORef a -> IORef a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. IORef a -> IORef a -> Bool
== :: IORef a -> IORef a -> Bool
$c/= :: forall a. IORef a -> IORef a -> Bool
/= :: IORef a -> IORef a -> Bool
Eq
  -- ^ Pointer equality.
  --
  -- @since base-4.0.0.0

-- |Build a new 'IORef'
newIORef    :: a -> IO (IORef a)
newIORef :: forall a. a -> IO (IORef a)
newIORef a
v = ST RealWorld (STRef RealWorld a) -> IO (STRef RealWorld a)
forall a. ST RealWorld a -> IO a
stToIO (a -> ST RealWorld (STRef RealWorld a)
forall a s. a -> ST s (STRef s a)
newSTRef a
v) IO (STRef RealWorld a)
-> (STRef RealWorld a -> IO (IORef a)) -> IO (IORef a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ STRef RealWorld a
var -> IORef a -> IO (IORef a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (STRef RealWorld a -> IORef a
forall a. STRef RealWorld a -> IORef a
IORef STRef RealWorld a
var)

-- |Read the value of an 'IORef'.
--
-- Beware that the CPU executing a thread can reorder reads or writes
-- to independent locations. See "Data.IORef#memmodel" for more details.
readIORef   :: IORef a -> IO a
readIORef :: forall a. IORef a -> IO a
readIORef  (IORef STRef RealWorld a
var) = ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO (STRef RealWorld a -> ST RealWorld a
forall s a. STRef s a -> ST s a
readSTRef STRef RealWorld a
var)

-- |Write a new value into an 'IORef'.
--
-- This function does not create a memory barrier and can be reordered
-- with other independent reads and writes within a thread, which may cause issues
-- for multithreaded execution. In these cases, consider using 'GHC.Internal.Data.IORef.atomicWriteIORef'
-- instead. See "Data.IORef#memmodel" for more details.
writeIORef  :: IORef a -> a -> IO ()
writeIORef :: forall a. IORef a -> a -> IO ()
writeIORef (IORef STRef RealWorld a
var) a
v = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (STRef RealWorld a -> a -> ST RealWorld ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef RealWorld a
var a
v)

-- | Atomically apply a function to the contents of an 'IORef',
-- installing its first component in the 'IORef' and returning
-- the old contents and the result of applying the function.
-- The result of the function application (the pair) is not forced.
-- As a result, this can lead to memory leaks. It is generally better
-- to use 'atomicModifyIORef2'.
atomicModifyIORef2Lazy :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))
atomicModifyIORef2Lazy :: forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
atomicModifyIORef2Lazy (IORef (STRef MutVar# RealWorld a
r#)) a -> (a, b)
f =
  (State# RealWorld -> (# State# RealWorld, (a, (a, b)) #))
-> IO (a, (a, b))
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case MutVar# RealWorld a
-> (a -> (a, b))
-> State# RealWorld
-> (# State# RealWorld, a, (a, b) #)
forall d a c.
MutVar# d a -> (a -> c) -> State# d -> (# State# d, a, c #)
atomicModifyMutVar2# MutVar# RealWorld a
r# a -> (a, b)
f State# RealWorld
s of
              (# State# RealWorld
s', a
old, (a, b)
res #) -> (# State# RealWorld
s', (a
old, (a, b)
res) #))

-- | Atomically apply a function to the contents of an 'IORef',
-- installing its first component in the 'IORef' and returning
-- the old contents and the result of applying the function.
-- The result of the function application (the pair) is forced,
-- but neither of its components is.
atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))
atomicModifyIORef2 :: forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
atomicModifyIORef2 IORef a
ref a -> (a, b)
f = do
  r@(_old, (_new, _res)) <- IORef a -> (a -> (a, b)) -> IO (a, (a, b))
forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
atomicModifyIORef2Lazy IORef a
ref a -> (a, b)
f
  return r

-- | A version of 'GHC.Internal.Data.IORef.atomicModifyIORef' that forces
-- the (pair) result of the function.
atomicModifyIORefP :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORefP :: forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORefP IORef a
ref a -> (a, b)
f = do
  (_old, (_,r)) <- IORef a -> (a -> (a, b)) -> IO (a, (a, b))
forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
atomicModifyIORef2 IORef a
ref a -> (a, b)
f
  pure r

-- | Atomically apply a function to the contents of an
-- 'IORef' and return the old and new values. The result
-- of the function is not forced. As this can lead to a
-- memory leak, it is usually better to use `atomicModifyIORef'_`.
atomicModifyIORefLazy_ :: IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORefLazy_ :: forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORefLazy_ (IORef (STRef MutVar# RealWorld a
ref)) a -> a
f = (State# RealWorld -> (# State# RealWorld, (a, a) #)) -> IO (a, a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, (a, a) #)) -> IO (a, a))
-> (State# RealWorld -> (# State# RealWorld, (a, a) #))
-> IO (a, a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case MutVar# RealWorld a
-> (a -> a) -> State# RealWorld -> (# State# RealWorld, a, a #)
forall d a.
MutVar# d a -> (a -> a) -> State# d -> (# State# d, a, a #)
atomicModifyMutVar_# MutVar# RealWorld a
ref a -> a
f State# RealWorld
s of
    (# State# RealWorld
s', a
old, a
new #) -> (# State# RealWorld
s', (a
old, a
new) #)

-- | Atomically apply a function to the contents of an
-- 'IORef' and return the old and new values. The result
-- of the function is forced.
atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ :: forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ IORef a
ref a -> a
f = do
  (old, !new) <- IORef a -> (a -> a) -> IO (a, a)
forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORefLazy_ IORef a
ref a -> a
f
  return (old, new)

-- | Atomically replace the contents of an 'IORef', returning
-- the old contents.
atomicSwapIORef :: IORef a -> a -> IO a
atomicSwapIORef :: forall a. IORef a -> a -> IO a
atomicSwapIORef (IORef (STRef MutVar# RealWorld a
ref)) a
new = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (MutVar# RealWorld a
-> a -> State# RealWorld -> (# State# RealWorld, a #)
forall d a. MutVar# d a -> a -> State# d -> (# State# d, a #)
atomicSwapMutVar# MutVar# RealWorld a
ref a
new)

-- | A strict version of 'GHC.Internal.Data.IORef.atomicModifyIORef'.  This forces both the
-- value stored in the 'IORef' and the value returned.
--
-- Conceptually,
--
-- @
-- atomicModifyIORef' ref f = do
--   -- Begin atomic block
--   old <- 'readIORef' ref
--   let r = f old
--       new = fst r
--   'writeIORef' ref new
--   -- End atomic block
--   case r of
--     (!_new, !res) -> pure res
-- @
--
-- The actions in the \"atomic block\" are not subject to interference
-- by other threads. In particular, the value in the 'IORef' cannot
-- change between the 'readIORef' and 'writeIORef' invocations.
--
-- The new value is installed in the 'IORef' before either value is forced.
-- So
--
-- @atomicModifyIORef' ref (\x -> (x+1, undefined))@
--
-- will increment the 'IORef' and then throw an exception in the calling
-- thread.
--
-- @atomicModifyIORef' ref (\x -> (undefined, x))@
--
-- and
--
-- @atomicModifyIORef' ref (\_ -> undefined)@
--
-- will each raise an exception in the calling thread, but will /also/
-- install the bottoming value in the 'IORef', where it may be read by
-- other threads.
--
-- This function imposes a memory barrier, preventing reordering around
-- the \"atomic block\"; see "Data.IORef#memmodel" for details.
--
-- @since base-4.6.0.0
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
-- See Note [atomicModifyIORef' definition]
atomicModifyIORef' :: forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef a
ref a -> (a, b)
f = do
  (_old, (_new, !res)) <- IORef a -> (a -> (a, b)) -> IO (a, (a, b))
forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
atomicModifyIORef2 IORef a
ref ((a -> (a, b)) -> IO (a, (a, b)))
-> (a -> (a, b)) -> IO (a, (a, b))
forall a b. (a -> b) -> a -> b
$
    \a
old -> case a -> (a, b)
f a
old of
       r :: (a, b)
r@(!a
_new, b
_res) -> (a, b)
r
  pure res

-- Note [atomicModifyIORef' definition]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- atomicModifyIORef' was historically defined
--
--    atomicModifyIORef' ref f = do
--        b <- atomicModifyIORef ref $ \a ->
--                case f a of
--                    v@(a',_) -> a' `seq` v
--        b `seq` return b
--
-- The most obvious definition, now that we have atomicModifyMutVar2#,
-- would be
--
--    atomicModifyIORef' ref f = do
--      (_old, (!_new, !res)) <- atomicModifyIORef2 ref f
--      pure res
--
-- Why do we force the new value on the "inside" instead of afterwards?
-- I initially thought the latter would be okay, but then I realized
-- that if we write
--
--   atomicModifyIORef' ref $ \x -> (x + 5, x - 5)
--
-- then we'll end up building a pair of thunks to calculate x + 5
-- and x - 5. That's no good! With the more complicated definition,
-- we avoid this problem; the result pair is strict in the new IORef
-- contents. Of course, if the function passed to atomicModifyIORef'
-- doesn't inline, we'll build a closure for it. But that was already
-- true for the historical definition of atomicModifyIORef' (in terms
-- of atomicModifyIORef), so we shouldn't lose anything. Note that
-- in keeping with the historical behavior, we *don't* propagate the
-- strict demand on the result inwards. In particular,
--
--   atomicModifyIORef' ref (\x -> (x + 1, undefined))
--
-- will increment the IORef and throw an exception; it will not
-- install an undefined value in the IORef.
--
-- A clearer version, in my opinion (but one quite incompatible with
-- the traditional one) would only force the new IORef value and not
-- the result. This version would have been relatively inefficient
-- to implement using atomicModifyMutVar#, but is just fine now.