\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,
+ unsafeDupablePerformIO, unsafeDupableInterleaveIO,
+ noDuplicate,
+
+ -- 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
+import Foreign.C.Types (CInt)
#ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Dynamic
+import {-# SOURCE #-} Data.Typeable ( showsTypeRep )
+import {-# SOURCE #-} Data.Dynamic ( Dynamic, dynTypeRep )
#endif
-- ---------------------------------------------------------------------------
-- ---------------------------------------------------------------------------
-- Coercions between IO and ST
---stToIO :: (forall s. ST s a) -> IO a
+-- | A monad transformer embedding strict state transformers in the 'IO'
+-- monad. The 'RealWorld' parameter indicates that the internal state
+-- used by the 'ST' computation is a special one supplied by the 'IO'
+-- monad, and thus distinct from those used by invocations of 'runST'.
stToIO :: ST RealWorld a -> IO a
stToIO (ST m) = IO m
ioToST :: IO a -> ST RealWorld a
ioToST (IO m) = (ST m)
+-- This relies on IO and ST having the same representation modulo the
+-- constraint on the type of the state
+--
+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
>
> main = do
> writeIORef test [42]
-> bang \<- readIORef test
+> bang <- readIORef test
> print (bang :: [Char])
This program will core dump. This problem with polymorphic references
possible to write @coerce :: a -> b@ with the
help of 'unsafePerformIO'. So be careful!
-}
-{-# NOINLINE unsafePerformIO #-}
unsafePerformIO :: IO a -> a
-unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
+
+{-|
+This version of 'unsafePerformIO' is slightly more efficient,
+because it omits the check that the IO is only being performed by a
+single thread. Hence, when you write 'unsafeDupablePerformIO',
+there is a possibility that the IO action may be performed multiple
+times (on a multiprocessor), and you should therefore ensure that
+it gives the same results each time.
+-}
+{-# NOINLINE unsafeDupablePerformIO #-}
+unsafeDupablePerformIO :: IO a -> a
+unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
+
+-- Why do we NOINLINE unsafeDupablePerformIO? See the comment with
+-- GHC.ST.runST. Essentially the issue is that the IO computation
+-- inside unsafePerformIO must be atomic: it must either all run, or
+-- 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 unsafeDupablePerformIO?
+-- If we don't have it, the demand analyser discovers the following strictness
+-- for unsafeDupablePerformIO: C(U(AV))
+-- But then consider
+-- unsafeDupablePerformIO (\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 unsafeDupablePerformIO,
+-- by hiding it with 'lazy'
{-|
'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
when the value of the @a@ is demanded. This is used to implement lazy
file reading, see 'System.IO.hGetContents'.
-}
-{-# NOINLINE unsafeInterleaveIO #-}
+{-# INLINE unsafeInterleaveIO #-}
unsafeInterleaveIO :: IO a -> IO a
-unsafeInterleaveIO (IO m)
+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.
+
+{-# INLINE unsafeDupableInterleaveIO #-}
+unsafeDupableInterleaveIO :: IO a -> IO a
+unsafeDupableInterleaveIO (IO m)
= IO ( \ s -> let
r = case m s of (# _, res #) -> res
in
(# s, r #))
+{-|
+Ensures that the suspensions under evaluation by the current thread
+are unique; that is, the current thread is not evaluating anything
+that is also under evaluation by another thread that has also executed
+'noDuplicate'.
+
+This operation is used in the definition of 'unsafePerformIO' to
+prevent the IO action from being executed multiple times, which is usually
+undesirable.
+-}
+noDuplicate :: IO ()
+noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
+
-- ---------------------------------------------------------------------------
-- Handle type
-- enough information to identify the handle for debugging. A handle is
-- equal according to '==' only to itself; no attempt
-- is made to compare the internal state of different handles for equality.
+--
+-- GHC note: a 'Handle' will be automatically closed when the garbage
+-- collector detects that it has become unreferenced by the program.
+-- However, relying on this behaviour is not generally recommended:
+-- the garbage collector is unpredictable. If possible, use explicit
+-- an explicit 'hClose' to close 'Handle's when they are no longer
+-- required. GHC does not currently attempt to free up file
+-- descriptors when they have run out, it is your responsibility to
+-- ensure that this doesn't happen.
data Handle
= FileHandle -- A normal handle to a file
(DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2
_ == _ = False
-type FD = Int -- XXX ToDo: should be CInt
+type FD = CInt
data Handle__
= Handle__ {
haFD :: !FD, -- file descriptor
haType :: HandleType, -- type (read/write/append etc.)
haIsBin :: Bool, -- binary mode?
- haIsStream :: Bool, -- is this a stream handle?
+ haIsStream :: Bool, -- Windows : is this a socket?
+ -- Unix : is O_NONBLOCK set?
haBufferMode :: BufferMode, -- buffer contains read/write data?
haBuffer :: !(IORef Buffer), -- the current buffer
haBuffers :: !(IORef BufferList), -- spare buffers
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.
-- but not less frequently, than specified above.
-- The output buffer is emptied as soon as it has been written out.
--
--- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
+-- Similarly, input occurs according to the buffer mode for the handle:
--
-- * /line-buffering/: when the buffer for the handle is not empty,
-- the next item is obtained from the buffer; otherwise, when the
-- the next block of data is read into the buffer.
--
-- * /no-buffering/: the next input item is read and returned.
--- The 'hLookAhead' operation implies that even a no-buffered handle
--- may require a one-character buffer.
+-- The 'System.IO.hLookAhead' operation implies that even a no-buffered
+-- handle may require a one-character buffer.
--
-- The default buffering mode when a handle is opened is
-- implementation-dependent and may depend on the file system object
-- |The type of exceptions. Every kind of system-generated exception
-- has a constructor in the 'Exception' type, and values of other
-- types may be injected into 'Exception' by coercing them to
--- 'Dynamic' (see the section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions").
+-- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions:
+-- "Control.Exception\#DynamicExceptions").
data Exception
= ArithException ArithException
-- ^Exceptions raised by arithmetic
-- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.Exception\#AsynchronousExceptions").
| BlockedOnDeadMVar
-- ^The current thread was executing a call to
- -- 'takeMVar' that could never return, because there are no other
- -- references to this 'MVar'.
+ -- 'Control.Concurrent.MVar.takeMVar' that could never return,
+ -- because there are no other references to this 'MVar'.
+ | BlockedIndefinitely
+ -- ^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
-- -----------------------------------------------------------------------------
-- The ExitCode type
--- The `ExitCode' type defines the exit codes that a program
--- can return. `ExitSuccess' indicates successful termination;
--- and `ExitFailure code' indicates program failure
--- with value `code'. The exact interpretation of `code'
--- is operating-system dependent. In particular, some values of
--- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
-
-- We need it here because it is used in ExitException in the
-- Exception datatype (above).
-data ExitCode = ExitSuccess | ExitFailure Int
- deriving (Eq, Ord, Read, Show)
+data ExitCode
+ = ExitSuccess -- ^ indicates successful termination;
+ | ExitFailure Int
+ -- ^ indicates program failure with an exit code.
+ -- The exact interpretation of the code is
+ -- operating-system dependent. In particular, some values
+ -- may be prohibited (e.g. 0 on a POSIX-compliant system).
+ deriving (Eq, Ord, Read, Show)
-- --------------------------------------------------------------------------
-- Primitive throw
-- 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