base-4.19.1.0: Basic libraries
Copyright(c) The University of Glasgow 2001
LicenseBSD-style (see the file libraries/base/LICENSE)
Maintainerlibraries@haskell.org
Stabilitystable
Portabilityportable
Safe HaskellTrustworthy
LanguageHaskell2010

Data.IORef

Description

Mutable references in the IO monad.

Synopsis

IORefs

data IORef a Source #

A mutable variable in the IO monad.

>>> import 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 STRef and MVar.

Instances

Instances details
Eq (IORef a) Source #

Pointer equality.

Since: base-4.0.0.0

Instance details

Defined in GHC.IORef

Methods

(==) :: IORef a -> IORef a -> Bool Source #

(/=) :: IORef a -> IORef a -> Bool Source #

newIORef :: a -> IO (IORef a) Source #

Build a new IORef

readIORef :: IORef a -> IO a Source #

Read the value of an IORef.

Beware that the CPU executing a thread can reorder reads or writes to independent locations. See Data.IORef for more details.

writeIORef :: IORef a -> a -> IO () Source #

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 atomicWriteIORef instead. See Data.IORef for more details.

modifyIORef :: IORef a -> (a -> a) -> IO () Source #

Mutate the contents of an IORef, combining readIORef and writeIORef. This is not an atomic update, consider using atomicModifyIORef when operating in a multithreaded environment.

Be warned that modifyIORef does not apply the function strictly. This means if the program calls modifyIORef many times, but seldom uses the value, thunks will pile up in memory resulting in a space leak. This is a common mistake made when using an IORef as a counter. For example, the following will likely produce a stack overflow:

ref <- newIORef 0
replicateM_ 1000000 $ modifyIORef ref (+1)
readIORef ref >>= print

To avoid this problem, use modifyIORef' instead.

modifyIORef' :: IORef a -> (a -> a) -> IO () Source #

Strict version of modifyIORef. This is not an atomic update, consider using atomicModifyIORef' when operating in a multithreaded environment.

Since: base-4.6.0.0

atomicModifyIORef :: IORef a -> (a -> (a, b)) -> IO b Source #

Atomically modifies the contents of an IORef.

This function is useful for using IORef in a safe way in a multithreaded program. If you only have one IORef, then using atomicModifyIORef to access and modify it will prevent race conditions.

Extending the atomicity to multiple IORefs is problematic, so it is recommended that if you need to do anything more complicated then using MVar instead is a good idea.

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 section labeled "atomic block" are not subject to interference from other threads. In particular, it is impossible for the value in the IORef to change between the readIORef and writeIORef invocations.

The user-supplied function is applied to the value stored in the IORef, yielding a new value to store in the IORef and a value to return. After the new value is (lazily) stored in the IORef, atomicModifyIORef forces the result pair, but does not force either component of the result. To force both components, use atomicModifyIORef'.

Note that

atomicModifyIORef ref (_ -> undefined)

will 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 for details.

atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b Source #

A strict version of 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 for details.

Since: base-4.6.0.0

atomicWriteIORef :: IORef a -> a -> IO () Source #

Variant of writeIORef. The prefix "atomic" relates to a fact that it imposes a reordering barrier, similar to atomicModifyIORef. Such a write will not be reordered with other reads or writes even on CPUs with weak memory model.

Since: base-4.6.0.0

mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) Source #

Make a Weak pointer to an IORef, using the second argument as a finalizer to run when IORef is garbage-collected

Memory Model

Most modern CPU achitectures (e.g. x86/64, ARM) have a memory model which allows threads to reorder reads with earlier writes to different locations, e.g. see the x86/64 architecture manual, 8.2.3.4 Loads May Be Reordered with Earlier Stores to Different Locations.

Because of that, in a concurrent program, IORef operations may appear out-of-order to another thread. In the following example:

import Data.IORef
import Control.Monad (unless)
import Control.Concurrent (forkIO, threadDelay)

maybePrint :: IORef Bool -> IORef Bool -> IO ()
maybePrint myRef yourRef = do
  writeIORef myRef True
  yourVal <- readIORef yourRef
  unless yourVal $ putStrLn "critical section"

main :: IO ()
main = do
  r1 <- newIORef False
  r2 <- newIORef False
  forkIO $ maybePrint r1 r2
  forkIO $ maybePrint r2 r1
  threadDelay 1000000

it is possible that the string "critical section" is printed twice, even though there is no interleaving of the operations of the two threads that allows that outcome. The memory model of x86/64 allows readIORef to happen before the earlier writeIORef.

The ARM memory order model is typically even weaker than x86/64, allowing any reordering of reads and writes as long as they are independent from the point of view of the current thread.

The implementation is required to ensure that reordering of memory operations cannot cause type-correct code to go wrong. In particular, when inspecting the value read from an IORef, the memory writes that created that value must have occurred from the point of view of the current thread.

atomicWriteIORef, atomicModifyIORef and atomicModifyIORef' act as a barrier to reordering. Multiple calls to these functions occur in strict program order, never taking place ahead of any earlier (in program order) IORef operations, or after any later IORef operations.