maxigit
December 27, 2023, 12:07pm
1
I know the s
of ST S a
can’t escape from the ST
Monad, unless it’s s ~ RealWord
. You can then run it as IO
using stToIO
. So for example one can (in ghci)
:m + Control.Monad.ST Data.STRef
ref <- stToIO $ newSTRef (1 :: Int)
stToIO $ modifySTRef ref (+1)
stToIO $ readSTRef ref
>> 2
So is STRef RealdWorld
and IORef
equivalent or I am missing something ?
sgraf
December 27, 2023, 1:59pm
2
STRef RealWorld
and IORef
are both backed by a primitive MutVar#
plus a shared pool of primitive operations, so their runtime behavior is indentical.
There’s also ioToST
via which ST RealWorld
and IO
are coercible. So as far as GHC is concerned, the two are represented identically, but that is far from a precise specification of how the semantics interacts with ambient IO
.
This means that the whole "ST s
is pure" story is treated a bit fast and loose by GHC. For example, it currently assumes that f :: ST s a -> ST s a
does not throw precise exceptions, but of course that’s untrue for stToIo $ f $ ioToST $ throwIO (mkUserError "sdflkj")
: #24263: Precise exceptions: `stToIO` and `ioToST` can circumvent analysis in Note [Which scrutinees may throw precise exceptions] · Issues · Glasgow Haskell Compiler / GHC · GitLab So far, nobody has complained about this uncompositional treatment and fixing it would either necessitate a complicated analysis and/or introduce quite a few perf regressions to existing code.
1 Like
jaror
December 27, 2023, 2:05pm
3
I’ve raised a related issue with the CLC, but I don’t personally have much stake in this problem:
opened 10:50PM - 17 Jan 23 UTC
closed 10:00PM - 25 Mar 23 UTC
abandoned
## Summary
The existence of the safe [`stToIO`](https://hackage.haskell.org/p… ackage/base-4.17.0.0/docs/Control-Monad-ST.html#v:stToIO) function enables one to use `ST` computations in multiple threads. This means we technically don't have the guarantee that `ST` computations run in a single thread which most people expect and base their programs on. I propose address this by deprecating `stToIO`, introducing one safe but more restricted replacement and one function which does the same thing but is explicitly marked unsafe, and adding documentation about this issue.
## Example
We might think `ST` computations are single-threaded an thus do not need to use atomic operations (in fact, `STRef` has no atomic `modify` operation), so we might write a `programST` function as follows:
```haskell
programST :: STRef s Integer -> ST s ()
programST ref = do
n <- readSTRef ref
if n <= 0
then pure ()
else do
unsafeIOToST yield
writeSTRef ref $! n - 1
programST ref
```
(The `unsafeIOToST yield` is only to make it more likely that weird concurrent interleavings occur)
But we can actually use this function in an unsafe way:
```haskell
countdownST :: Integer -> IO Integer
countdownST n = do
ref <- stToIO (newSTRef n)
forkIO $ stToIO (programST ref)
stToIO (programST ref)
s <- stToIO (readSTRef ref)
pure s
main :: IO ()
main = do
putStrLn . show =<< countdownST 1000000
```
Compiling with `ghc -O2 T.hs -threaded` and running with `./T +RTS -N2` sometimes gives me unexpected results:
```
$ ./T +RTS -N2
129
$ ./T +RTS -N2
100
```
<details><summary>Click to expand full repro source code</summary>
```haskell
import Control.Monad.ST
import Control.Monad.ST.Unsafe
import Control.Concurrent
import Data.STRef
programST :: STRef s Integer -> ST s ()
programST ref = do
n <- readSTRef ref
if n <= 0
then pure ()
else do
unsafeIOToST yield
writeSTRef ref $! n - 1
programST ref
countdownST :: Integer -> IO Integer
countdownST n = do
ref <- stToIO (newSTRef n)
forkIO $ stToIO (programST ref)
stToIO (programST ref)
s <- stToIO (readSTRef ref)
pure s
main :: IO ()
main = do
putStrLn . show =<< countdownST 1000000
```
</details>
## Proposed changes
I propose to introduce two new functions:
```haskell
safeSTToIO :: (forall s. ST s a) -> IO a
safeSTToIO (ST f) = IO f
unsafeRealSTToIO :: ST RealWorld a -> IO a
unsafeRealSTToIO (ST f) = IO f
```
Additionally, I propose to deprecate (but not remove) `stToIO` suggesting users to use the new `safeSTToIO` or `unsafeSTToIO` instead.
I do not propose removing `stToIO` because that would break too many existing packages. Perhaps we can consider that at a later time, when most of the ecosystem has adapted to this change.
Addtionally, documentation should be updated to explain the unsafety.
## Impact
The results from [this hackage search](https://hackage-search.serokell.io/?q=stToIO) shows that there are 674 matches of the string `stToIO` in 95 packages. Some matches may be in comments, using the more complicated pattern `stToIO\s*[$(]|=\s*stToIO` in an attempt to exclude occurrences in comments yields 515 matches across 71 packages.
Adding a deprecation warning lets package maintainers update their packages at their own pace, so I expect the migration to be a smooth process.
## See also
https://gitlab.haskell.org/ghc/ghc/-/issues/22780
https://gitlab.haskell.org/ghc/ghc/-/issues/22764#note_473050
TL;DR: ST
actions are expected to be run in a single thread, but stToIO
can break that expectation.
2 Likes
sgraf
December 27, 2023, 2:22pm
4
Wow, what a hornet’s nest.
(page 13 of 51)
4. Input/output
Now that we have the state-transformer framework in place, we can give a new account of input/output. An I/O-performing computation is of type ST RealWorld a
; that is, it is a state transformer transforming a state of type RealWorld
, and delivering a value of type a
. The only thing which makes it special is the type of the state it transforms, namely RealWorld
an abstract type whose values represent the real world. It is convenient to use a type synonym to express this specialisation:
type IO a = ST RealWorld a
Since IO a
is an instance of ST s a
, it follows that all the state-transformer primitives concerning references and arrays work equally well when mixed with I/O operations.
State in Haskell (1995)
…so the original intention was that STRef RealdWorld
and IORef
would be equivalent. But having just seen @jaror ’s proposal, @sgraf ’s one-line summary seems appropriate:
Wow, what a hornet’s nest.
So much for “progress” !
2 Likes