[commit: ghc] master: Make unsafeInterleaveST less unsafe (30d68d6)
git at git.haskell.org
git at git.haskell.org
Wed Mar 22 21:29:32 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/30d68d630c1685bb81ec4afdaf6d483ba8aafd38/ghc
>---------------------------------------------------------------
commit 30d68d630c1685bb81ec4afdaf6d483ba8aafd38
Author: David Feuer <david.feuer at gmail.com>
Date: Wed Mar 22 17:25:03 2017 -0400
Make unsafeInterleaveST less unsafe
* Make `unsafeInterleaveST` use `noDuplicate#` like
`unsafeInterleaveIO` does to prevent the suspended action from
being run in two threads.
* In order to accomplish this without `unsafeCoerce#`, generalize
the type of `noDuplicate#`.
* Add `unsafeDupableInterleaveST` to get the old behavior.
* Document unsafe `ST` functions and clean up some related
documentation.
Fixes #13457
Reviewers: austin, hvr, bgamari, ekmett
Reviewed By: bgamari
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3370
>---------------------------------------------------------------
30d68d630c1685bb81ec4afdaf6d483ba8aafd38
compiler/prelude/primops.txt.pp | 2 +-
libraries/base/Control/Monad/ST/Imp.hs | 4 +++-
libraries/base/Control/Monad/ST/Unsafe.hs | 1 +
libraries/base/GHC/IO.hs | 19 ++++++++++++++-----
libraries/base/GHC/IO/Unsafe.hs | 16 +++++++++++++++-
libraries/base/GHC/ST.hs | 26 +++++++++++++++++++++++---
6 files changed, 57 insertions(+), 11 deletions(-)
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index b81fd12..a313920 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2358,7 +2358,7 @@ primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp
has_side_effects = True
primop NoDuplicateOp "noDuplicate#" GenPrimOp
- State# RealWorld -> State# RealWorld
+ State# s -> State# s
with
out_of_line = True
has_side_effects = True
diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs
index 984970f..c053dcc 100644
--- a/libraries/base/Control/Monad/ST/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Imp.hs
@@ -29,10 +29,12 @@ module Control.Monad.ST.Imp (
-- * Unsafe operations
unsafeInterleaveST,
+ unsafeDupableInterleaveST,
unsafeIOToST,
unsafeSTToIO
) where
-import GHC.ST ( ST, runST, fixST, unsafeInterleaveST )
+import GHC.ST ( ST, runST, fixST, unsafeInterleaveST
+ , unsafeDupableInterleaveST )
import GHC.Base ( RealWorld )
import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO )
diff --git a/libraries/base/Control/Monad/ST/Unsafe.hs b/libraries/base/Control/Monad/ST/Unsafe.hs
index 9fa4b73..b8560b1 100644
--- a/libraries/base/Control/Monad/ST/Unsafe.hs
+++ b/libraries/base/Control/Monad/ST/Unsafe.hs
@@ -21,6 +21,7 @@
module Control.Monad.ST.Unsafe (
-- * Unsafe operations
unsafeInterleaveST,
+ unsafeDupableInterleaveST,
unsafeIOToST,
unsafeSTToIO
) where
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
index 8459db6..63b47ff 100644
--- a/libraries/base/GHC/IO.hs
+++ b/libraries/base/GHC/IO.hs
@@ -84,22 +84,31 @@ failIO s = IO (raiseIO# (toException (userError s)))
-- ---------------------------------------------------------------------------
-- Coercions between IO and ST
--- | A monad transformer embedding strict state transformers in the 'IO'
--- monad. The 'RealWorld' parameter indicates that the internal state
+-- | Embed a strict state transformer in an 'IO'
+-- action. The 'RealWorld' parameter indicates that the internal state
-- used by the 'ST' computation is a special one supplied by the 'IO'
-- monad, and thus distinct from those used by invocations of 'runST'.
stToIO :: ST RealWorld a -> IO a
stToIO (ST m) = IO m
+-- | Convert an 'IO' action into an 'ST' action. The type of the result
+-- is constrained to use a 'RealWorld' state, and therefore the result cannot
+-- be passed to 'runST'.
ioToST :: IO a -> ST RealWorld a
ioToST (IO m) = (ST m)
--- This relies on IO and ST having the same representation modulo the
--- constraint on the type of the state
---
+-- | Convert an 'IO' action to an 'ST' action.
+-- This relies on 'IO' and 'ST' having the same representation modulo the
+-- constraint on the type of the state.
unsafeIOToST :: IO a -> ST s a
unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
+-- | Convert an 'ST' action to an 'IO' action.
+-- This relies on 'IO' and 'ST' having the same representation modulo the
+-- constraint on the type of the state.
+--
+-- For an example demonstrating why this is unsafe, see
+-- https://mail.haskell.org/pipermail/haskell-cafe/2009-April/060719.html
unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index 7523535..c1c07ae 100644
--- a/libraries/base/GHC/IO/Unsafe.hs
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -104,7 +104,7 @@ unsafeDupablePerformIO :: IO a -> a
unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a
{-|
-'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
+'unsafeInterleaveIO' allows an 'IO' computation to be deferred lazily.
When passed a value of type @IO a@, the 'IO' will only be performed
when the value of the @a@ is demanded. This is used to implement lazy
file reading, see 'System.IO.hGetContents'.
@@ -113,6 +113,9 @@ file reading, see 'System.IO.hGetContents'.
unsafeInterleaveIO :: IO a -> IO a
unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
+-- Note [unsafeDupableInterleaveIO should not be inlined]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
-- We used to believe that INLINE on unsafeInterleaveIO was safe,
-- because the state from this IO thread is passed explicitly to the
-- interleaved IO, so it cannot be floated out and shared.
@@ -131,7 +134,18 @@ unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
-- share and sometimes not (plus it probably breaks the noDuplicate).
-- So now, we do not inline unsafeDupableInterleaveIO.
+{-|
+'unsafeDupableInterleaveIO' allows an 'IO' computation to be deferred lazily.
+When passed a value of type @IO a@, the 'IO' will only be performed
+when the value of the @a@ is demanded.
+
+The computation may be performed multiple times by different threads,
+possibly at the same time. To ensure that the computation is performed
+only once, use 'unsafeInterleaveIO' instead.
+-}
+
{-# NOINLINE unsafeDupableInterleaveIO #-}
+-- See Note [unsafeDupableInterleaveIO should not be inlined]
unsafeDupableInterleaveIO :: IO a -> IO a
unsafeDupableInterleaveIO (IO m)
= IO ( \ s -> let
diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs
index 7982d59..4e00c0e 100644
--- a/libraries/base/GHC/ST.hs
+++ b/libraries/base/GHC/ST.hs
@@ -21,7 +21,7 @@ module GHC.ST (
fixST, runST,
-- * Unsafe functions
- liftST, unsafeInterleaveST
+ liftST, unsafeInterleaveST, unsafeDupableInterleaveST
) where
import GHC.Base
@@ -84,9 +84,29 @@ data STret s a = STret (State# s) a
liftST :: ST s a -> State# s -> STret s a
liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r
-{-# NOINLINE unsafeInterleaveST #-}
+noDuplicateST :: ST s ()
+noDuplicateST = ST $ \s -> (# noDuplicate# s, () #)
+
+-- | 'unsafeInterleaveST' allows an 'ST' computation to be deferred
+-- lazily. When passed a value of type @ST a@, the 'ST' computation will
+-- only be performed when the value of the @a@ is demanded.
+{-# INLINE unsafeInterleaveST #-}
unsafeInterleaveST :: ST s a -> ST s a
-unsafeInterleaveST (ST m) = ST ( \ s ->
+unsafeInterleaveST m = unsafeDupableInterleaveST (noDuplicateST >> m)
+
+-- | 'unsafeDupableInterleaveST' allows an 'ST' computation to be deferred
+-- lazily. When passed a value of type @ST a@, the 'ST' computation will
+-- only be performed when the value of the @a@ is demanded.
+--
+-- The computation may be performed multiple times by different threads,
+-- possibly at the same time. To prevent this, use 'unsafeInterleaveST' instead.
+--
+-- @since 4.11
+{-# NOINLINE unsafeDupableInterleaveST #-}
+-- See Note [unsafeDupableInterleaveIO should not be inlined]
+-- in GHC.IO.Unsafe
+unsafeDupableInterleaveST :: ST s a -> ST s a
+unsafeDupableInterleaveST (ST m) = ST ( \ s ->
let
r = case m s of (# _, res #) -> res
in
More information about the ghc-commits
mailing list