X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIOBase.lhs;h=3442677316996ef2c2ac4d139db5081a7c113247;hb=9e32ed934a78ebe8cf65219949018a5f1035ae7e;hp=87001285c836fa016452f531eedecdfbae68d289;hpb=24b6429c53ce9f632963c9a8102d73afe35a50df;p=ghc-base.git diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 8700128..3442677 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.IOBase @@ -14,21 +14,48 @@ -- ----------------------------------------------------------------------------- -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 -- --------------------------------------------------------------------------- @@ -128,6 +155,9 @@ ioToST (IO m) = (ST m) 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 @@ -185,7 +215,7 @@ help of 'unsafePerformIO'. So be careful! -} {-# 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 @@ -193,6 +223,22 @@ unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -- 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 @@ -396,6 +442,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. @@ -568,6 +617,14 @@ data Exception -- ^The current thread was executing a call to -- '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 @@ -702,9 +759,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 "<>" @@ -724,6 +783,7 @@ instance Eq Exception where AsyncException e1 == AsyncException e2 = e1 == e2 BlockedOnDeadMVar == BlockedOnDeadMVar = True NonTermination == NonTermination = True + NestedAtomically == NestedAtomically = True Deadlock == Deadlock = True _ == _ = False @@ -755,8 +815,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