X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIOBase.lhs;h=684497e243a4905567f17b6d9b2d0488758eb527;hb=fd73317876a8b474b8ffa75443efda76cf1a1636;hp=187014621e7d65a7c6fbdc159e11aec359cb28a4;hpb=b72dda8318394f238214364dc01b8963599f8cd6;p=ghc-base.git diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 1870146..684497e 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -1,5 +1,6 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.IOBase @@ -14,21 +15,52 @@ -- ----------------------------------------------------------------------------- -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 -- --------------------------------------------------------------------------- @@ -112,13 +144,25 @@ returnIO x = IO (\ s -> (# s, x #)) -- --------------------------------------------------------------------------- -- 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 @@ -164,7 +208,7 @@ It is less well known that > > main = do > writeIORef test [42] -> bang \<- readIORef test +> bang <- readIORef test > print (bang :: [Char]) This program will core dump. This problem with polymorphic references @@ -174,9 +218,41 @@ once you use 'unsafePerformIO'. Indeed, it is 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. @@ -184,14 +260,35 @@ When passed a value of type @IO a@, the 'IO' will only be performed 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 @@ -247,6 +344,15 @@ instance Eq (MVar a) where -- 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 @@ -268,14 +374,15 @@ instance Eq Handle where (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 @@ -368,6 +475,9 @@ isWritableHandleType WriteHandle = True 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. @@ -396,7 +506,7 @@ type FilePath = String -- 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 @@ -408,8 +518,8 @@ type FilePath = String -- 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 @@ -518,7 +628,8 @@ showHandle file = showString "{handle: " . showString file . showString "}" -- |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 @@ -537,8 +648,16 @@ data Exception -- ^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 the 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 @@ -552,7 +671,7 @@ data Exception | ExitException ExitCode -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and -- 'System.Exit.exitFailure'). The 'ExitCode' argument is the value passed - -- to 'System.exitWith'. An unhandled 'ExitException' exception in the + -- to 'System.Exit.exitWith'. An unhandled 'ExitException' exception in the -- main thread will cause the program to be terminated with the given -- exit code. | IOException IOException @@ -620,7 +739,7 @@ data AsyncException -- * GHC currently does not throw 'HeapOverflow' exceptions. | ThreadKilled -- ^This exception is raised by another thread - -- calling 'killThread', or by the system + -- calling 'Control.Concurrent.killThread', or by the system -- if it needs to terminate the thread for some -- reason. deriving (Eq, Ord) @@ -673,9 +792,11 @@ instance Show Exception where 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 "<>" showsPrec _ (Deadlock) = showString "<>" @@ -695,24 +816,24 @@ instance Eq Exception where 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 @@ -727,8 +848,8 @@ throw exception = raise# exception -- 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 @@ -743,13 +864,18 @@ throwIO err = IO $ raiseIO# err ioException :: IOException -> IO a ioException err = IO $ raiseIO# (IOException err) +-- | Raise an 'IOError' in the 'IO' monad. ioError :: IOError -> IO a ioError = ioException -- --------------------------------------------------------------------------- -- IOError type --- | The Haskell 98 type for exceptions in the @IO@ monad. +-- | The Haskell 98 type for exceptions in the 'IO' monad. +-- Any I\/O operation may raise an 'IOError' instead of returning a result. +-- For a more general type of exception, including also those that arise +-- in pure code, see 'Control.Exception.Exception'. +-- -- In Haskell 98, this is an opaque type. type IOError = IOException @@ -771,6 +897,7 @@ instance Eq IOException where (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) = e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2 +-- | An abstract type that contains a value for each variant of 'IOError'. data IOErrorType -- Haskell 98: = AlreadyExists @@ -826,6 +953,14 @@ instance Show IOErrorType where UnsupportedOperation -> "unsupported operation" DynIOError{} -> "unknown IO error" +-- | Construct an 'IOError' value with a string describing the error. +-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a +-- 'userError', thus: +-- +-- > instance Monad IO where +-- > ... +-- > fail s = ioError (userError s) +-- userError :: String -> IOError userError str = IOError Nothing UserError "" str Nothing