1{-# LANGUAGE Unsafe #-}
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-}
4{-# OPTIONS_HADDOCK not-home #-}
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 'ST' operations until
18-- a value depending on them is required.
19--
20-----------------------------------------------------------------------------
21
22module 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
40import Control.Monad.Fix
41
42import qualified Control.Monad.ST as ST
43import qualified Control.Monad.ST.Unsafe as ST
44
45import qualified GHC.ST as GHC.ST
46import GHC.Base
47import qualified Control.Monad.Fail as Fail
48
49-- | The lazy @'ST' monad.
50-- The ST monad allows for destructive updates, but is escapable (unlike IO).
51-- A computation of type @'ST' s a@ returns a value of type @a@, and
52-- execute in "thread" @s@. The @s@ parameter is either
53--
54-- * an uninstantiated 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@
64newtype 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.
69data State s = S# (State# s)
70
71{- Note [Lazy ST and multithreading]
72
73We used to imagine that passing a polymorphic state token was all that we
74needed to keep state threads separate (see Launchbury and Peyton Jones, 1994:
75https://www.microsoft.com/en-us/research/publication/lazy-functional-state-threads/).
76But this breaks down in the face of concurrency (see #11760). Whereas a strict
77ST computation runs to completion before producing anything, a value produced
78by running a lazy ST computation may contain a thunk that, when forced, will
79lead to further stateful computations. If such a thunk is entered by more than
80one thread, then they may both read from and write to the same references and
81arrays, interfering with each other. To work around this, any time we lazily
82suspend execution of a lazy ST computation, we bind the result pair to a
83NOINLINE binding (ensuring that it is not duplicated) and calculate that
84pair using (unsafePerformIO . evaluate), ensuring that only one thread will
85enter the thunk. We still use lifted state tokens to actually drive execution,
86so in these cases we effectively deal with *two* state tokens: the lifted
87one we get from the previous computation, and the unlifted one we pull out of
88thin air. -}
89
90{- Note [Lazy ST: not producing lazy pairs]
91
92The fixST and strictToLazyST functions used to construct functions that
93produced lazy pairs. Why don't we need that laziness? The ST type is kept
94abstract, so no one outside this module can ever get their hands on a (result,
95State s) pair. We ourselves never match on such pairs when performing ST
96computations unless we also force one of their components. So no one should be
97able to detect the change. By refraining from producing such thunks (which
98reference delayed ST computations), we avoid having to ask whether we have to
99wrap 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.
103noDup :: a -> a
104noDup a = runRW# (\s ->
105  case noDuplicate# s of
106    _ -> a)
107
108-- | @since 2.01
109instance 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
127instance 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
182instance Monad (ST s) where
183    (>>) = (*>)
184
185    m >>= k = ST $ \ s ->
186       let
187         -- See Note [Lazy ST and multithreading]
188         {-# NOINLINE res #-}
189         res = noDup (unST m s)
190         (r,new_s) = res
191       in
192         unST (k r) new_s
193
194-- | @since 4.10
195instance Fail.MonadFail (ST s) where
196    fail s = errorWithoutStackTrace s
197
198-- | Return the value computed by an 'ST' computation.
199-- The @forall@ ensures that the internal state used by the 'ST'
200-- computation is inaccessible to the rest of the program.
201runST :: (forall s. ST s a) -> a
202runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r)
203
204-- | Allow the result of an 'ST' computation to be used (lazily)
205-- inside the computation.
206-- Note that if @f@ is strict, @'fixST' f = _|_@.
207fixST :: (a -> ST s a) -> ST s a
208fixST m = ST (\ s ->
209                let
210                   q@(r,_s') = unST (m r) s
211                in q)
212-- Why don't we need unsafePerformIO in fixST? We create a thunk, q,
213-- to perform a lazy state computation, and we pass a reference to that
214-- thunk, r, to m. Uh oh? No, I think it should be fine, because that thunk
215-- itself is demanded directly in the `let` body. See also
216-- Note [Lazy ST: not producing lazy pairs].
217
218-- | @since 2.01
219instance MonadFix (ST s) where
220        mfix = fixST
221
222-- ---------------------------------------------------------------------------
223-- Strict <--> Lazy
224
225{-|
226Convert a strict 'ST' computation into a lazy one.  The strict state
227thread passed to 'strictToLazyST' is not performed until the result of
228the lazy state thread it returns is demanded.
229-}
230strictToLazyST :: ST.ST s a -> ST s a
231strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) ->
232  case m s of
233    (# s', a #) -> (a, S# s')
234-- See Note [Lazy ST: not producing lazy pairs]
235
236{-|
237Convert a lazy 'ST' computation into a strict one.
238-}
239lazyToStrictST :: ST s a -> ST.ST s a
240lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
241        case (m (S# s)) of (a, S# s') -> (# s', a #)
242
243-- | A monad transformer embedding lazy 'ST' in the 'IO'
244-- monad.  The 'RealWorld' parameter indicates that the internal state
245-- used by the 'ST' computation is a special one supplied by the 'IO'
246-- monad, and thus distinct from those used by invocations of 'runST'.
247stToIO :: ST RealWorld a -> IO a
248stToIO = ST.stToIO . lazyToStrictST
249
250-- ---------------------------------------------------------------------------
251-- Strict <--> Lazy
252
253unsafeInterleaveST :: ST s a -> ST s a
254unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
255
256unsafeIOToST :: IO a -> ST s a
257unsafeIOToST = strictToLazyST . ST.unsafeIOToST
258
259