X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIOBase.lhs;h=cf3c5ebe8b66830881f9540210489630fc1ebe66;hb=e1399bdcde01f55824973b556f60eecbe4dc2250;hp=3e6462ab144d7ddb25cf8e2fbe38c51e54224654;hpb=4836cf1053a971fe823ba547a8268431745c5bce;p=ghc-base.git diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 3e6462a..cf3c5eb 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -17,6 +17,8 @@ module GHC.IOBase 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 @@ -55,6 +57,19 @@ Libraries - parts of hslibs/lang. --SDM -} +{-| +A value of type @'IO' a@ is a computation which, when performed, +does some I\/O before returning a value of type @a@. + +There is really only one way to \"perform\" an I\/O action: bind it to +@Main.main@ in your program. When your program is run, the I\/O will +be performed. It isn't possible to perform I\/O from an arbitrary +function, unless that function is itself in the 'IO' monad and called +at some point, directly or indirectly, from @Main.main@. + +'IO' is a monad, so 'IO' actions can be combined using either the do-notation +or the '>>' and '>>=' operations from the 'Monad' class. +-} newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) @@ -107,10 +122,68 @@ ioToST (IO m) = (ST m) -- --------------------------------------------------------------------------- -- Unsafe IO operations +{-| +This is the \"back door\" into the 'IO' monad, allowing +'IO' computation to be performed at any time. For +this to be safe, the 'IO' computation should be +free of side effects and independent of its environment. + +If the I\/O computation wrapped in 'unsafePerformIO' +performs side effects, then the relative order in which those side +effects take place (relative to the main I\/O trunk, or other calls to +'unsafePerformIO') is indeterminate. You have to be careful when +writing and compiling modules that use 'unsafePerformIO': + + * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@ + that calls 'unsafePerformIO'. If the call is inlined, + the I\/O may be performed more than once. + + * Use the compiler flag @-fno-cse@ to prevent common sub-expression + elimination being performed on the module, which might combine + two side effects that were meant to be separate. A good example + is using multiple global variables (like @test@ in the example below). + + * Make sure that the either you switch off let-floating, or that the + call to 'unsafePerformIO' cannot float outside a lambda. For example, + if you say: + @ + f x = unsafePerformIO (newIORef []) + @ + you may get only one reference cell shared between all calls to @f@. + Better would be + @ + f x = unsafePerformIO (newIORef [x]) + @ + because now it can't float outside the lambda. + +It is less well known that +'unsafePerformIO' is not type safe. For example: + +> test :: IORef [a] +> test = unsafePerformIO $ newIORef [] +> +> main = do +> writeIORef test [42] +> bang \<- readIORef test +> print (bang :: [Char]) + +This program will core dump. This problem with polymorphic references +is well known in the ML community, and does not arise with normal +monadic use of references. There is no easy way to make it impossible +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 +{-| +'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily. +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 #-} unsafeInterleaveIO :: IO a -> IO a unsafeInterleaveIO (IO m) @@ -123,6 +196,11 @@ unsafeInterleaveIO (IO m) -- Handle type data MVar a = MVar (MVar# RealWorld a) +{- ^ +An 'MVar' (pronounced \"em-var\") is a synchronising variable, used +for communication between concurrent threads. It can be thought of +as a a box, which may be empty or full. +-} -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module instance Eq (MVar a) where @@ -312,18 +390,58 @@ data BufferMode -- --------------------------------------------------------------------------- -- IORefs +-- |A mutable variable in the 'IO' monad newtype IORef a = IORef (STRef RealWorld a) deriving Eq +-- |Build a new 'IORef' newIORef :: a -> IO (IORef a) newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var) +-- |Read the value of an 'IORef' readIORef :: IORef a -> IO a readIORef (IORef var) = stToIO (readSTRef var) +-- |Write a new value into an 'IORef' writeIORef :: IORef a -> a -> IO () writeIORef (IORef var) v = stToIO (writeSTRef var v) -- --------------------------------------------------------------------------- +-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. +-- The type arguments are as follows: +-- +-- * @i@: the index type of the array (should be an instance of @Ix@) +-- +-- * @e@: the element type of the array. +-- +-- + +newtype IOArray i e = IOArray (STArray RealWorld i e) deriving Eq + +-- |Build a new 'IOArray' +newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e) +{-# INLINE newIOArray #-} +newIOArray lu init = stToIO $ do {marr <- newSTArray lu init; return (IOArray marr)} + +-- | Read a value from an 'IOArray' +unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e +{-# INLINE unsafeReadIOArray #-} +unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i) + +-- | Write a new value into an 'IOArray' +unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO () +{-# INLINE unsafeWriteIOArray #-} +unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e) + +-- | Read a value from an 'IOArray' +readIOArray :: Ix i => IOArray i e -> i -> IO e +readIOArray (IOArray marr) i = stToIO (readSTArray marr i) + +-- | Write a new value into an 'IOArray' +writeIOArray :: Ix i => IOArray i e -> i -> e -> IO () +writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e) + + +-- --------------------------------------------------------------------------- -- Show instance for Handles -- handle types are 'show'n when printing error msgs, so @@ -385,24 +503,84 @@ showHandle p h duplex = -- ------------------------------------------------------------------------ -- Exception datatype and operations +-- |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 Exception - = IOException IOException -- IO exceptions - | ArithException ArithException -- Arithmetic exceptions - | ArrayException ArrayException -- Array-related exceptions - | ErrorCall String -- Calls to 'error' - | ExitException ExitCode -- Call to System.exitWith - | NoMethodError String -- A non-existent method was invoked - | PatternMatchFail String -- A pattern match / guard failure - | RecSelError String -- Selecting a non-existent field - | RecConError String -- Field missing in record construction - | RecUpdError String -- Record doesn't contain updated field - | AssertionFailed String -- Assertions - | DynException Dynamic -- Dynamic exceptions - | AsyncException AsyncException -- Externally generated errors - | BlockedOnDeadMVar -- Blocking on a dead MVar - | Deadlock -- no threads can run (raised in main thread) + = ArithException ArithException + -- ^Exceptions raised by arithmetic + -- operations. (NOTE: GHC currently does not throw + -- 'ArithException's except for 'DivideByZero'). + | ArrayException ArrayException + -- ^Exceptions raised by array-related + -- operations. (NOTE: GHC currently does not throw + -- 'ArrayException's). + | AssertionFailed String + -- ^This exception is thrown by the + -- 'assert' operation when the condition + -- fails. The 'String' argument contains the + -- location of the assertion in the source program. + | AsyncException AsyncException + -- ^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'. + | Deadlock + -- ^There are no runnable threads, so the program is + -- deadlocked. The 'Deadlock' exception is + -- raised in the main thread only (see also: "Control.Concurrent"). + | DynException Dynamic + -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions"). + | ErrorCall String + -- ^The 'ErrorCall' exception is thrown by 'error'. The 'String' + -- argument of 'ErrorCall' is the string passed to 'error' when it was + -- called. + | ExitException ExitCode + -- ^The 'ExitException' exception is thrown by 'System.exitWith' (and + -- 'System.exitFailure'). The 'ExitCode' argument is the value passed + -- to 'System.exitWith'. An unhandled 'ExitException' exception in the + -- main thread will cause the program to be terminated with the given + -- exit code. + | IOException IOException + -- ^These are the standard IO exceptions generated by + -- Haskell\'s @IO@ operations. See also "System.IO.Error". + | NoMethodError String + -- ^An attempt was made to invoke a class method which has + -- no definition in this instance, and there was no default + -- definition given in the class declaration. GHC issues a + -- warning when you compile an instance which has missing + -- methods. | NonTermination - + -- ^The current thread is stuck in an infinite loop. This + -- exception may or may not be thrown when the program is + -- non-terminating. + | PatternMatchFail String + -- ^A pattern matching failure. The 'String' argument should contain a + -- descriptive message including the function name, source file + -- and line number. + | RecConError String + -- ^An attempt was made to evaluate a field of a record + -- for which no value was given at construction time. The + -- 'String' argument gives the location of the + -- record construction in the source program. + | RecSelError String + -- ^A field selection was attempted on a constructor that + -- doesn\'t have the requested field. This can happen with + -- multi-constructor records when one or more fields are + -- missing from some of the constructors. The + -- 'String' argument gives the location of the + -- record selection in the source program. + | RecUpdError String + -- ^An attempt was made to update a field in a record, + -- where the record doesn\'t have the requested field. This can + -- only occur with multi-constructor records, when one or more + -- fields are missing from some of the constructors. The + -- 'String' argument gives the location of the + -- record update in the source program. + +-- |The type of arithmetic exceptions data ArithException = Overflow | Underflow @@ -411,15 +589,38 @@ data ArithException | Denormal deriving (Eq, Ord) + +-- |Asynchronous exceptions data AsyncException = StackOverflow + -- ^The current thread\'s stack exceeded its limit. + -- Since an exception has been raised, the thread\'s stack + -- will certainly be below its limit again, but the + -- programmer should take remedial action + -- immediately. | HeapOverflow + -- ^The program\'s heap is reaching its limit, and + -- the program should take action to reduce the amount of + -- live data it has. Notes: + -- + -- * It is undefined which thread receives this exception. + -- + -- * GHC currently does not throw 'HeapOverflow' exceptions. | ThreadKilled + -- ^This exception is raised by another thread + -- calling 'killThread', or by the system + -- if it needs to terminate the thread for some + -- reason. deriving (Eq, Ord) +-- | Exceptions generated by array operations data ArrayException - = IndexOutOfBounds String -- out-of-range array access - | UndefinedElement String -- evaluating an undefined element + = IndexOutOfBounds String + -- ^An attempt was made to index an array outside + -- its declared bounds. + | UndefinedElement String + -- ^An attempt was made to evaluate an element of an + -- array that had not been initialized. deriving (Eq, Ord) stackOverflow, heapOverflow :: Exception -- for the RTS @@ -483,6 +684,7 @@ instance Eq Exception where BlockedOnDeadMVar == BlockedOnDeadMVar = True NonTermination == NonTermination = True Deadlock == Deadlock = True + _ == _ = False -- ----------------------------------------------------------------------------- -- The ExitCode type @@ -503,32 +705,53 @@ data ExitCode = ExitSuccess | ExitFailure Int -- -------------------------------------------------------------------------- -- Primitive throw +-- | Throw an exception. Exceptions may be thrown from purely +-- functional code, but may only be caught within the 'IO' monad. throw :: Exception -> a throw exception = raise# exception -ioError :: Exception -> IO a -ioError err = IO $ \s -> throw err s +-- | A variant of 'throw' that can be used within the 'IO' monad. +-- +-- 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 () +-- +-- The first example will cause the exception @e@ to be raised, +-- whereas the second one won\'t. In fact, 'throwIO' will only cause +-- an exception to be raised when it is used within the 'IO' monad. +-- The 'throwIO' variant should be used in preference to 'throw' to +-- raise an exception within the 'IO' monad because it guarantees +-- ordering with respect to other 'IO' operations, whereas 'throw' +-- does not. +throwIO :: Exception -> IO a +throwIO err = IO $ \s -> throw err s ioException :: IOException -> IO a ioException err = IO $ \s -> throw (IOException err) s +ioError :: IOError -> IO a +ioError = ioException + -- --------------------------------------------------------------------------- -- IOError type --- A value @IOError@ encode errors occurred in the @IO@ monad. --- An @IOError@ records a more specific error type, a descriptive +-- | The Haskell 98 type for exceptions in the @IO@ monad. +-- In Haskell 98, this is an opaque type. +type IOError = IOException + +-- |Exceptions that occur in the @IO@ monad. +-- An @IOException@ records a more specific error type, a descriptive -- string and maybe the handle that was used when the error was -- flagged. - -type IOError = Exception - data IOException = IOError { ioe_handle :: Maybe Handle, -- the handle used by the action flagging -- the error. ioe_type :: IOErrorType, -- what it was. ioe_location :: String, -- location. - ioe_descr :: String, -- error type specific information. + ioe_description :: String, -- error type specific information. ioe_filename :: Maybe FilePath -- filename the error is related to. } @@ -564,7 +787,7 @@ instance Eq IOErrorType where x == y = case x of DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst? - _ -> getTag# x ==# getTag# y + _ -> getTag x ==# getTag y instance Show IOErrorType where showsPrec _ e = @@ -592,7 +815,7 @@ instance Show IOErrorType where DynIOError{} -> "unknown IO error" userError :: String -> IOError -userError str = IOException (IOError Nothing UserError "" str Nothing) +userError str = IOError Nothing UserError "" str Nothing -- --------------------------------------------------------------------------- -- Showing IOErrors @@ -612,4 +835,10 @@ instance Show IOException where (case fn of Nothing -> id Just name -> showString "\nFile: " . showString name) + +-- ----------------------------------------------------------------------------- +-- IOMode type + +data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode + deriving (Eq, Ord, Ix, Enum, Read, Show) \end{code}