[commit: base] master: add unsafeFixIO (#5421) (8174ee2)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8174ee234f971daa7e477139fc026693ceae038f

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

commit 8174ee234f971daa7e477139fc026693ceae038f
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Mon Nov 7 09:19:09 2011 +0000

    add unsafeFixIO (#5421)

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

 System/IO/Unsafe.hs |   25 ++++++++++++++++++++++++-
 1 files changed, 24 insertions(+), 1 deletions(-)

diff --git a/System/IO/Unsafe.hs b/System/IO/Unsafe.hs
index b420662..33620a3 100644
--- a/System/IO/Unsafe.hs
+++ b/System/IO/Unsafe.hs
@@ -20,10 +20,15 @@ module System.IO.Unsafe (
    unsafePerformIO,     -- :: IO a -> a
    unsafeDupablePerformIO, -- :: IO a -> a
    unsafeInterleaveIO,  -- :: IO a -> IO a
+   unsafeFixIO,
   ) where
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.IO      (unsafePerformIO, unsafeInterleaveIO, unsafeDupablePerformIO)
+import GHC.Base
+import GHC.IO
+import GHC.IORef
+import GHC.Exception
+import Control.Exception
 #endif
 
 #ifdef __HUGS__
@@ -36,3 +41,21 @@ import NHC.Internal (unsafePerformIO, unsafeInterleaveIO)
 unsafeDupablePerformIO = unsafePerformIO
 #endif
 
+-- | A slightly faster version of `System.IO.fixIO` that may not be
+-- safe to use with multiple threads.  The unsafety arises when used
+-- like this:
+--
+-- >  unsafeFixIO $ \r ->
+-- >     forkIO (print r)
+-- >     return (...)
+--
+-- In this case, the child thread will receive a @NonTermination@
+-- exception instead of waiting for the value of @r@ to be computed.
+--
+unsafeFixIO :: (a -> IO a) -> IO a
+unsafeFixIO k = do
+  ref <- newIORef (throw NonTermination)
+  ans <- unsafeDupableInterleaveIO (readIORef ref)
+  result <- k ans
+  writeIORef ref result
+  return result