unsafeInterleaveIO duplicates computation when evaluated by multiple threads
When the following code is compiled with -O1 or -O2, the interleaved computation (putStrLn "eval") is performed 1000 times, rather than once:
import Control.Concurrent
import Control.Exception (evaluate)
import Control.Monad
import System.IO.Unsafe
main :: IO ()
main = do
x <- unsafeInterleaveIO $ putStrLn "eval"
replicateM_ 1000 $ forkIO $ evaluate x >> return ()
threadDelay 1000000
Taking a look at the source to unsafeInterleaveIO:
{-# INLINE unsafeInterleaveIO #-}
unsafeInterleaveIO :: IO a -> IO a
unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
-- We believe that INLINE on unsafeInterleaveIO is safe, because the
-- state from this IO thread is passed explicitly to the interleaved
-- IO, so it cannot be floated out and shared.
It seems the comment about INLINE is not true. If I define the following function:
interleave :: IO a -> IO a
interleave = unsafeInterleaveIO
{-# NOINLINE interleave #-}
and replace unsafeInterleaveIO with interleave, "eval" is printed only once. If I change NOINLINE to INLINE, or if I remove the pragma altogether, "eval" is printed 1000 times.
I believe unsafeInterleaveIO should guarantee that computations are not repeated. Otherwise, we end up with strangeness like this:
import Control.Applicative
import Control.Concurrent
import Control.Monad
main :: IO ()
main = do
chan <- newChan :: IO (Chan Int)
mapM_ (writeChan chan) [0..999]
items <- take 10 <$> getChanContents chan
replicateM_ 5 $ forkIO $ putStrLn $ "items = " ++ show items
threadDelay 1000000
which prints:
items = [0,1,2,3,4,5,6,7,8,9]
items = [10,11,12,13,14,15,16,17,18,19]
items = [20,21,22,23,24,25,26,27,28,29]
items = [30,31,32,33,34,35,36,37,38,39]
items = [40,41,42,43,44,45,46,47,48,49]
For the time being, programs can work around this by using a NOINLINE wrapper:
getChanContents' :: Chan a -> IO [a]
getChanContents' = getChanContents
{-# NOINLINE getChanContents' #-}
I tested this on Linux 64-bit with GHC 7.2.2 and ghc-7.4.0.20120111, and on Windows 32-bit with GHC 7.0.3 and 7.2.2. All of these platforms and versions exhibit the same behavior. The bug goes away when the program is compiled with -O0, or when functions returning interleaved computations are marked NOINLINE (e.g. getChanContents').
Trac metadata
Trac field | Value |
---|---|
Version | 7.2.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |