Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9ab1f46d601e0f4c4582a1a77d9b4c26bf166daa >--------------------------------------------------------------- commit 9ab1f46d601e0f4c4582a1a77d9b4c26bf166daa Author: Simon Marlow <[email protected]> Date: Fri Mar 23 12:28:18 2012 +0000 change unsafeDupableInterleaveIO from INLINE to NOINLINE (#5943) See the comment for details. >--------------------------------------------------------------- GHC/IO.hs | 22 ++++++++++++++++++---- 1 files changed, 18 insertions(+), 4 deletions(-) diff --git a/GHC/IO.hs b/GHC/IO.hs index f30f768..6e7e7f7 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -208,11 +208,25 @@ file reading, see 'System.IO.hGetContents'. 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. +-- 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. +-- +-- HOWEVER, if the compiler figures out that r is used strictly here, +-- then it will eliminate the thunk and the side effects in m will no +-- longer be shared in the way the programmer was probably expecting, +-- but can be performed many times. In #5943, this broke our +-- definition of fixIO, which contains +-- +-- ans <- unsafeInterleaveIO (takeMVar m) +-- +-- after inlining, we lose the sharing of the takeMVar, so the second +-- time 'ans' was demanded we got a deadlock. We could fix this with +-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes +-- share and sometimes not (plus it probably breaks the noDuplicate). +-- So now, we do not inline unsafeDupableInterleaveIO. -{-# INLINE unsafeDupableInterleaveIO #-} +{-# NOINLINE unsafeDupableInterleaveIO #-} unsafeDupableInterleaveIO :: IO a -> IO a unsafeDupableInterleaveIO (IO m) = IO ( \ s -> let _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
