\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IOBase
--
-----------------------------------------------------------------------------
-module GHC.IOBase where
-
+-- #hide
+module GHC.IOBase(
+ IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO,
+ unsafePerformIO, unsafeInterleaveIO,
+
+ -- To and from from ST
+ stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
+
+ -- References
+ IORef(..), newIORef, readIORef, writeIORef,
+ IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
+ MVar(..),
+
+ -- Handles, file descriptors,
+ FilePath,
+ Handle(..), Handle__(..), HandleType(..), IOMode(..), FD,
+ isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,
+
+ -- Buffers
+ Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
+ bufferIsWritable, bufferEmpty, bufferFull,
+
+ -- Exceptions
+ Exception(..), ArithException(..), AsyncException(..), ArrayException(..),
+ stackOverflow, heapOverflow, throw, throwIO, ioException,
+ IOError, IOException(..), IOErrorType(..), ioError, userError,
+ ExitCode(..)
+ ) where
+
import GHC.ST
import GHC.Arr -- to derive Ix class
import GHC.Enum -- to derive Enum class
import GHC.STRef
import GHC.Base
-import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude
+-- import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude
import Data.Maybe ( Maybe(..) )
import GHC.Show
import GHC.List
import GHC.Read
#ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Dynamic
+import {-# SOURCE #-} GHC.Dynamic
#endif
-- ---------------------------------------------------------------------------
unsafeIOToST :: IO a -> ST s a
unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
+unsafeSTToIO :: ST s a -> IO a
+unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
+
-- ---------------------------------------------------------------------------
-- Unsafe IO operations
-}
{-# NOINLINE unsafePerformIO #-}
unsafePerformIO :: IO a -> a
-unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
-- Why do we NOINLINE unsafePerformIO? See the comment with
-- GHC.ST.runST. Essentially the issue is that the IO computation
-- not at all. If we let the compiler see the application of the IO
-- to realWorld#, it might float out part of the IO.
+-- Why is there a call to 'lazy' in unsafePerformIO?
+-- If we don't have it, the demand analyser discovers the following strictness
+-- for unsafePerformIO: C(U(AV))
+-- But then consider
+-- unsafePerformIO (\s -> let r = f x in
+-- case writeIORef v r s of (# s1, _ #) ->
+-- (# s1, r #)
+-- The strictness analyser will find that the binding for r is strict,
+-- (becuase of uPIO's strictness sig), and so it'll evaluate it before
+-- doing the writeIORef. This actually makes tests/lib/should_run/memo002
+-- get a deadlock!
+--
+-- Solution: don't expose the strictness of unsafePerformIO,
+-- by hiding it with 'lazy'
+
+
{-|
'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
When passed a value of type @IO a@, the 'IO' will only be performed
isWritableHandleType ReadWriteHandle = True
isWritableHandleType _ = False
+isReadWriteHandleType ReadWriteHandle{} = True
+isReadWriteHandleType _ = False
+
-- | File and directory names are values of type 'String', whose precise
-- meaning is operating system dependent. Files can be opened, yielding a
-- handle which can then be used to operate on the contents of that file.
-- ^The current thread was waiting to retry an atomic memory transaction
-- that could never become possible to complete because there are no other
-- threads referring to any of teh TVars involved.
+ | NestedAtomically
+ -- ^The runtime detected an attempt to nest one STM transaction
+ -- inside another one, presumably due to the use of
+ -- 'unsafePeformIO' with 'atomically'.
| Deadlock
-- ^There are no runnable threads, so the program is
-- deadlocked. The 'Deadlock' exception is
showsPrec _ (RecConError err) = showString err
showsPrec _ (RecUpdError err) = showString err
showsPrec _ (AssertionFailed err) = showString err
- showsPrec _ (DynException _err) = showString "unknown exception"
+ showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err)
showsPrec _ (AsyncException e) = shows e
showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
showsPrec _ (BlockedIndefinitely) = showString "thread blocked indefinitely"
+ showsPrec _ (NestedAtomically) = showString "Control.Concurrent.STM.atomically was nested"
showsPrec _ (NonTermination) = showString "<<loop>>"
showsPrec _ (Deadlock) = showString "<<deadlock>>"
AsyncException e1 == AsyncException e2 = e1 == e2
BlockedOnDeadMVar == BlockedOnDeadMVar = True
NonTermination == NonTermination = True
+ NestedAtomically == NestedAtomically = True
Deadlock == Deadlock = True
_ == _ = False
-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
-- two functions are subtly different:
--
--- > throw e `seq` return () ===> throw e
--- > throwIO e `seq` return () ===> return ()
+-- > throw e `seq` x ===> throw e
+-- > throwIO e `seq` x ===> x
--
-- The first example will cause the exception @e@ to be raised,
-- whereas the second one won\'t. In fact, 'throwIO' will only cause
projects / haskell-directory.git / blobdiff