[commit: ghc] ghc-8.2: Make unsafeInterleaveST less unsafe (167548f)

git at git.haskell.org git at git.haskell.org
Mon Mar 27 02:59:57 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/167548f4cd087535a6c4c9fc642b60669b4dc019/ghc

>---------------------------------------------------------------

commit 167548f4cd087535a6c4c9fc642b60669b4dc019
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
    
    (cherry picked from commit 30d68d630c1685bb81ec4afdaf6d483ba8aafd38)


>---------------------------------------------------------------

167548f4cd087535a6c4c9fc642b60669b4dc019
 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 64971a3..5d0a2a4 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2344,7 +2344,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