{-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO.Unsafe -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- \"Unsafe\" IO operations. -- ----------------------------------------------------------------------------- module System.IO.Unsafe ( -- * Unsafe 'System.IO.IO' operations unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO, unsafeFixIO, ) where import GHC.Base import GHC.IO import GHC.IORef import GHC.Exception import Control.Exception -- | 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 -> do -- > 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. -- -- @since 4.5.0.0 unsafeFixIO :: (a -> IO a) -> IO a unsafeFixIO :: forall a. (a -> IO a) -> IO a unsafeFixIO a -> IO a k = do IORef a ref <- forall a. a -> IO (IORef a) newIORef (forall a e. Exception e => e -> a throw NonTermination NonTermination) a ans <- forall a. IO a -> IO a unsafeDupableInterleaveIO (forall a. IORef a -> IO a readIORef IORef a ref) a result <- a -> IO a k a ans forall a. IORef a -> a -> IO () writeIORef IORef a ref a result forall (m :: * -> *) a. Monad m => a -> m a return a result