1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IORef
-- Copyright : (c) The University of Glasgow 2008
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- The IORef type
--
-----------------------------------------------------------------------------
module GHC.IORef (
IORef(..),
newIORef, readIORef, writeIORef, atomicModifyIORef2Lazy,
atomicModifyIORef2, atomicModifyIORefLazy_, atomicModifyIORef'_,
atomicModifyIORefP, atomicSwapIORef, atomicModifyIORef'
) where
import GHC.Base
import GHC.STRef
import GHC.IO
-- ---------------------------------------------------------------------------
-- IORefs
-- |A mutable variable in the 'IO' monad
newtype IORef a = IORef (STRef RealWorld a)
deriving Eq -- ^ @since 4.2.0.0
-- ^ Pointer equality.
--
-- @since 4.1.0.0
-- |Build a new 'IORef'
newIORef :: a -> IO (IORef a)
newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
-- |Read the value of an 'IORef'
readIORef :: IORef a -> IO a
readIORef (IORef var) = stToIO (readSTRef var)
-- |Write a new value into an 'IORef'
writeIORef :: IORef a -> a -> IO ()
writeIORef (IORef var) v = stToIO (writeSTRef var 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 (IORef (STRef r#)) f =
IO (\s -> case atomicModifyMutVar2# r# f s of
(# s', old, res #) -> (# s', (old, 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 ref f = do
r@(_old, (_new, _res)) <- atomicModifyIORef2Lazy ref f
return r
-- | A version of 'Data.IORef.atomicModifyIORef' that forces
-- the (pair) result of the function.
atomicModifyIORefP :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORefP ref f = do
(_old, (_,r)) <- atomicModifyIORef2 ref 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_ (IORef (STRef ref)) f = IO $ \s ->
case atomicModifyMutVar_# ref f s of
(# s', old, new #) -> (# s', (old, 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'_ ref f = do
(old, !new) <- atomicModifyIORefLazy_ ref f
return (old, new)
-- | Atomically replace the contents of an 'IORef', returning
-- the old contents.
atomicSwapIORef :: IORef a -> a -> IO a
-- Bad implementation! This will be a primop shortly.
atomicSwapIORef (IORef (STRef ref)) new = IO $ \s ->
case atomicModifyMutVar2# ref (\_old -> Box new) s of
(# s', old, Box _new #) -> (# s', old #)
data Box a = Box a
-- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both
-- the value stored in the 'IORef' and the value returned. The new value
-- is installed in the 'IORef' before the returned value is forced.
-- So
--
-- @atomicModifyIORef' ref (\x -> (x+1, undefined))@
--
-- will increment the 'IORef' and then throw an exception in the calling
-- thread.
--
-- @since 4.6.0.0
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
-- See Note [atomicModifyIORef' definition]
atomicModifyIORef' ref f = do
(_old, (_new, !res)) <- atomicModifyIORef2 ref $
\old -> case f old of
r@(!_new, _res) -> 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.
|
