67d5838356c0c43ec87b732a785c9f05fe56668c
[ghc.git] / libraries / base / Control / Monad / ST / Lazy / Imp.hs
1 {-# LANGUAGE Unsafe #-}
2 {-# LANGUAGE BangPatterns #-}
3 {-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : Control.Monad.ST.Lazy.Imp
9 -- Copyright : (c) The University of Glasgow 2001
10 -- License : BSD-style (see the file libraries/base/LICENSE)
11 --
12 -- Maintainer : libraries@haskell.org
13 -- Stability : provisional
14 -- Portability : non-portable (requires universal quantification for runST)
15 --
16 -- This module presents an identical interface to "Control.Monad.ST",
17 -- except that the monad delays evaluation of state operations until
18 -- a value depending on them is required.
19 --
20 -----------------------------------------------------------------------------
21
22 module Control.Monad.ST.Lazy.Imp (
23 -- * The 'ST' monad
24 ST,
25 runST,
26 fixST,
27
28 -- * Converting between strict and lazy 'ST'
29 strictToLazyST, lazyToStrictST,
30
31 -- * Converting 'ST' To 'IO'
32 RealWorld,
33 stToIO,
34
35 -- * Unsafe operations
36 unsafeInterleaveST,
37 unsafeIOToST
38 ) where
39
40 import Control.Monad.Fix
41
42 import qualified Control.Monad.ST as ST
43 import qualified Control.Monad.ST.Unsafe as ST
44
45 import qualified GHC.ST as GHC.ST
46 import GHC.Base
47 import qualified Control.Monad.Fail as Fail
48
49 -- | The lazy state-transformer monad.
50 -- A computation of type @'ST' s a@ transforms an internal state indexed
51 -- by @s@, and returns a value of type @a@.
52 -- The @s@ parameter is either
53 --
54 -- * an unstantiated type variable (inside invocations of 'runST'), or
55 --
56 -- * 'RealWorld' (inside invocations of 'stToIO').
57 --
58 -- It serves to keep the internal states of different invocations of
59 -- 'runST' separate from each other and from invocations of 'stToIO'.
60 --
61 -- The '>>=' and '>>' operations are not strict in the state. For example,
62 --
63 -- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@
64 newtype ST s a = ST { unST :: State s -> (a, State s) }
65
66 -- A lifted state token. This can be imagined as a moment in the timeline
67 -- of a lazy state thread. Forcing the token forces all delayed actions in
68 -- the thread up until that moment to be performed.
69 data State s = S# (State# s)
70
71 {- Note [Lazy ST and multithreading]
72
73 We used to imagine that passing a polymorphic state token was all that we
74 needed to keep state threads separate (see Launchbury and Peyton Jones, 1994:
75 https://www.microsoft.com/en-us/research/publication/lazy-functional-state-threads/).
76 But this breaks down in the face of concurrency (see #11760). Whereas a strict
77 ST computation runs to completion before producing anything, a value produced
78 by running a lazy ST computation may contain a thunk that, when forced, will
79 lead to further stateful computations. If such a thunk is entered by more than
80 one thread, then they may both read from and write to the same references and
81 arrays, interfering with each other. To work around this, any time we lazily
82 suspend execution of a lazy ST computation, we bind the result pair to a
83 NOINLINE binding (ensuring that it is not duplicated) and calculate that
84 pair using (unsafePerformIO . evaluate), ensuring that only one thread will
85 enter the thunk. We still use lifted state tokens to actually drive execution,
86 so in these cases we effectively deal with *two* state tokens: the lifted
87 one we get from the previous computation, and the unlifted one we pull out of
88 thin air. -}
89
90 {- Note [Lazy ST: not producing lazy pairs]
91
92 The fixST and strictToLazyST functions used to construct functions that
93 produced lazy pairs. Why don't we need that laziness? The ST type is kept
94 abstract, so no one outside this module can ever get their hands on a (result,
95 State s) pair. We ourselves never match on such pairs when performing ST
96 computations unless we also force one of their components. So no one should be
97 able to detect the change. By refraining from producing such thunks (which
98 reference delayed ST computations), we avoid having to ask whether we have to
99 wrap them up with unsafePerformIO. See Note [Lazy ST and multithreading]. -}
100
101 -- | This is a terrible hack to prevent a thunk from being entered twice.
102 -- Simon Peyton Jones would very much like to be rid of it.
103 noDup :: a -> a
104 noDup a = runRW# (\s ->
105 case noDuplicate# s of
106 _ -> a)
107
108 -- | @since 2.01
109 instance Functor (ST s) where
110 fmap f m = ST $ \ s ->
111 let
112 -- See Note [Lazy ST and multithreading]
113 {-# NOINLINE res #-}
114 res = noDup (unST m s)
115 (r,new_s) = res
116 in
117 (f r,new_s)
118
119 x <$ m = ST $ \ s ->
120 let
121 {-# NOINLINE s' #-}
122 -- See Note [Lazy ST and multithreading]
123 s' = noDup (snd (unST m s))
124 in (x, s')
125
126 -- | @since 2.01
127 instance Applicative (ST s) where
128 pure a = ST $ \ s -> (a,s)
129
130 fm <*> xm = ST $ \ s ->
131 let
132 {-# NOINLINE res1 #-}
133 !res1 = unST fm s
134 !(f, s') = res1
135
136 {-# NOINLINE res2 #-}
137 -- See Note [Lazy ST and multithreading]
138 res2 = noDup (unST xm s')
139 (x, s'') = res2
140 in (f x, s'')
141 -- Why can we use a strict binding for res1? If someone
142 -- forces the (f x, s'') pair, then they must need
143 -- f or s''. To get s'', they need s'.
144
145 liftA2 f m n = ST $ \ s ->
146 let
147 {-# NOINLINE res1 #-}
148 -- See Note [Lazy ST and multithreading]
149 res1 = noDup (unST m s)
150 (x, s') = res1
151
152 {-# NOINLINE res2 #-}
153 res2 = noDup (unST n s')
154 (y, s'') = res2
155 in (f x y, s'')
156 -- We don't get to be strict in liftA2, but we clear out a
157 -- NOINLINE in comparison to the default definition, which may
158 -- help the simplifier.
159
160 m *> n = ST $ \s ->
161 let
162 {-# NOINLINE s' #-}
163 -- See Note [Lazy ST and multithreading]
164 s' = noDup (snd (unST m s))
165 in unST n s'
166
167 m <* n = ST $ \s ->
168 let
169 {-# NOINLINE res1 #-}
170 !res1 = unST m s
171 !(mr, s') = res1
172
173 {-# NOINLINE s'' #-}
174 -- See Note [Lazy ST and multithreading]
175 s'' = noDup (snd (unST n s'))
176 in (mr, s'')
177 -- Why can we use a strict binding for res1? The same reason as
178 -- in <*>. If someone demands the (mr, s'') pair, then they will
179 -- force mr or s''. To get s'', they need s'.
180
181 -- | @since 2.01
182 instance Monad (ST s) where
183
184 fail s = errorWithoutStackTrace s
185
186 (>>) = (*>)
187
188 m >>= k = ST $ \ s ->
189 let
190 -- See Note [Lazy ST and multithreading]
191 {-# NOINLINE res #-}
192 res = noDup (unST m s)
193 (r,new_s) = res
194 in
195 unST (k r) new_s
196
197 -- | @since 4.10
198 instance Fail.MonadFail (ST s) where
199 fail s = errorWithoutStackTrace s
200
201 -- | Return the value computed by a state transformer computation.
202 -- The @forall@ ensures that the internal state used by the 'ST'
203 -- computation is inaccessible to the rest of the program.
204 runST :: (forall s. ST s a) -> a
205 runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r)
206
207 -- | Allow the result of a state transformer computation to be used (lazily)
208 -- inside the computation.
209 -- Note that if @f@ is strict, @'fixST' f = _|_@.
210 fixST :: (a -> ST s a) -> ST s a
211 fixST m = ST (\ s ->
212 let
213 q@(r,_s') = unST (m r) s
214 in q)
215 -- Why don't we need unsafePerformIO in fixST? We create a thunk, q,
216 -- to perform a lazy state computation, and we pass a reference to that
217 -- thunk, r, to m. Uh oh? No, I think it should be fine, because that thunk
218 -- itself is demanded directly in the `let` body. See also
219 -- Note [Lazy ST: not producing lazy pairs].
220
221 -- | @since 2.01
222 instance MonadFix (ST s) where
223 mfix = fixST
224
225 -- ---------------------------------------------------------------------------
226 -- Strict <--> Lazy
227
228 {-|
229 Convert a strict 'ST' computation into a lazy one. The strict state
230 thread passed to 'strictToLazyST' is not performed until the result of
231 the lazy state thread it returns is demanded.
232 -}
233 strictToLazyST :: ST.ST s a -> ST s a
234 strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) ->
235 case m s of
236 (# s', a #) -> (a, S# s')
237 -- See Note [Lazy ST: not producing lazy pairs]
238
239 {-|
240 Convert a lazy 'ST' computation into a strict one.
241 -}
242 lazyToStrictST :: ST s a -> ST.ST s a
243 lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
244 case (m (S# s)) of (a, S# s') -> (# s', a #)
245
246 -- | A monad transformer embedding lazy state transformers in the 'IO'
247 -- monad. The 'RealWorld' parameter indicates that the internal state
248 -- used by the 'ST' computation is a special one supplied by the 'IO'
249 -- monad, and thus distinct from those used by invocations of 'runST'.
250 stToIO :: ST RealWorld a -> IO a
251 stToIO = ST.stToIO . lazyToStrictST
252
253 -- ---------------------------------------------------------------------------
254 -- Strict <--> Lazy
255
256 unsafeInterleaveST :: ST s a -> ST s a
257 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
258
259 unsafeIOToST :: IO a -> ST s a
260 unsafeIOToST = strictToLazyST . ST.unsafeIOToST
261