1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.36 2001/02/27 13:38:15 simonmar Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[PrelIOBase]{Module @PrelIOBase@}
9 Definitions for the @IO@ monad and its friends. Everything is exported
10 concretely; the @IO@ module itself exports abstractly.
13 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
15 #include "cbits/stgerror.h"
17 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
18 module PrelIOBase where
20 import {-# SOURCE #-} PrelErr ( error )
24 import PrelNum -- To get fromInteger etc, needed because of -fno-implicit-prelude
25 import PrelMaybe ( Maybe(..) )
30 import PrelPack ( unpackCString )
32 #if !defined(__CONCURRENT_HASKELL__)
33 import PrelArr ( MutableVar, readVar )
38 #define __CONCURRENT_HASKELL__
40 #define unpackCString primUnpackString
43 #ifndef __PARALLEL_HASKELL__
44 #define FILE_OBJECT (ForeignPtr ())
46 #define FILE_OBJECT (Ptr ())
51 %*********************************************************
53 \subsection{The @IO@ monad}
55 %*********************************************************
57 The IO Monad is just an instance of the ST monad, where the state is
58 the real world. We use the exception mechanism (in PrelException) to
59 implement IO exceptions.
61 NOTE: The IO representation is deeply wired in to various parts of the
62 system. The following list may or may not be exhaustive:
64 Compiler - types of various primitives in PrimOp.lhs
66 RTS - forceIO (StgMiscClosures.hc)
67 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
69 - raiseAsync (Schedule.c)
71 Prelude - PrelIOBase.lhs, and several other places including
74 Libraries - parts of hslibs/lang.
80 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
82 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
85 instance Functor IO where
86 fmap f x = x >>= (return . f)
88 instance Monad IO where
92 m >> k = m >>= \ _ -> k
96 fail s = ioError (userError s)
98 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
99 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
101 bindIO :: IO a -> (a -> IO b) -> IO b
102 bindIO (IO m) k = IO ( \ s ->
104 (# new_s, a #) -> unIO (k a) new_s
107 returnIO :: a -> IO a
108 returnIO x = IO (\ s -> (# s, x #))
112 %*********************************************************
114 \subsection{Coercions to @ST@}
116 %*********************************************************
120 /* Hugs doesn't distinguish these types so no coercion required) */
122 -- stToIO :: (forall s. ST s a) -> IO a
123 stToIO :: ST RealWorld a -> IO a
126 ioToST :: IO a -> ST RealWorld a
127 ioToST (IO m) = (ST m)
131 %*********************************************************
133 \subsection{Unsafe @IO@ operations}
135 %*********************************************************
139 {-# NOINLINE unsafePerformIO #-}
140 unsafePerformIO :: IO a -> a
141 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
143 {-# NOINLINE unsafeInterleaveIO #-}
144 unsafeInterleaveIO :: IO a -> IO a
145 unsafeInterleaveIO (IO m)
147 r = case m s of (# _, res #) -> res
153 %*********************************************************
155 \subsection{Types @Handle@, @Handle__@}
157 %*********************************************************
159 The type for @Handle@ is defined rather than in @IOHandle@
160 module, as the @IOError@ type uses it..all operations over
161 a handles reside in @IOHandle@.
167 Sigh, the MVar ops in ConcBase depend on IO, the IO
168 representation here depend on MVars for handles (when
169 compiling in a concurrent way). Break the cycle by having
170 the definition of MVars go here:
173 data MVar a = MVar (MVar# RealWorld a)
175 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
176 instance Eq (MVar a) where
177 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
180 Double sigh - ForeignPtr is needed here too to break a cycle.
182 data ForeignPtr a = ForeignPtr ForeignObj#
183 instance CCallable (ForeignPtr a)
185 eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool
187 = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
189 foreign import "eqForeignObj" unsafe
190 primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
192 instance Eq (ForeignPtr a) where
193 p == q = eqForeignPtr p q
194 p /= q = not (eqForeignPtr p q)
195 #endif /* ndef __HUGS__ */
197 #if defined(__CONCURRENT_HASKELL__)
198 newtype Handle = Handle (MVar Handle__)
200 newtype Handle = Handle (MutableVar RealWorld Handle__)
203 instance Eq Handle where
204 (Handle h1) == (Handle h2) = h1 == h2
207 A Handle is represented by (a reference to) a record
208 containing the state of the I/O port/device. We record
209 the following pieces of info:
211 * type (read,write,closed etc.)
212 * pointer to the external file object.
214 * user-friendly name (usually the
215 FilePath used when IO.openFile was called)
217 Note: when a Handle is garbage collected, we want to flush its buffer
218 and close the OS file handle, so as to free up a (precious) resource.
222 haFO__ :: FILE_OBJECT,
223 haType__ :: Handle__Type,
224 haBufferMode__ :: BufferMode,
225 haFilePath__ :: FilePath,
226 haBuffers__ :: [Ptr ()]
230 Internally, we classify handles as being one
242 -- File names are specified using @FilePath@, a OS-dependent
243 -- string that (hopefully, I guess) maps to an accessible file/object.
245 type FilePath = String
248 %*********************************************************
250 \subsection[Show-Handle]{Show instance for Handles}
252 %*********************************************************
255 -- handle types are 'show'ed when printing error msgs, so
256 -- we provide a more user-friendly Show instance for it
257 -- than the derived one.
258 instance Show Handle__Type where
261 ClosedHandle -> showString "closed"
262 SemiClosedHandle -> showString "semi-closed"
263 ReadHandle -> showString "readable"
264 WriteHandle -> showString "writeable"
265 AppendHandle -> showString "writeable (append)"
266 ReadWriteHandle -> showString "read-writeable"
268 instance Show Handle where
269 showsPrec p (Handle h) =
271 #if defined(__CONCURRENT_HASKELL__)
273 hdl_ = unsafePerformIO (primTakeMVar h)
275 -- (Big) SIGH: unfolded defn of takeMVar to avoid
276 -- an (oh-so) unfortunate module loop with PrelConc.
277 hdl_ = unsafePerformIO (IO $ \ s# ->
278 case h of { MVar h# ->
279 case takeMVar# h# s# of { (# s2# , r #) ->
280 case putMVar# h# r s2# of { s3# ->
284 hdl_ = unsafePerformIO (stToIO (readVar h))
288 showHdl (haType__ hdl_)
289 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
290 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
291 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
293 showHdl :: Handle__Type -> ShowS -> ShowS
296 ClosedHandle -> showsPrec p ht . showString "}\n"
299 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
302 NoBuffering -> showString "none"
303 LineBuffering -> showString "line"
304 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
305 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
308 def = unsafePerformIO (getBufSize fo)
311 %*********************************************************
313 \subsection[BufferMode]{Buffering modes}
315 %*********************************************************
317 Three kinds of buffering are supported: line-buffering,
318 block-buffering or no-buffering. These modes have the following
319 effects. For output, items are written out from the internal
320 buffer according to the buffer mode:
323 \item[line-buffering] the entire output buffer is written
324 out whenever a newline is output, the output buffer overflows,
325 a flush is issued, or the handle is closed.
327 \item[block-buffering] the entire output buffer is written out whenever
328 it overflows, a flush is issued, or the handle
331 \item[no-buffering] output is written immediately, and never stored
332 in the output buffer.
335 The output buffer is emptied as soon as it has been written out.
337 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
339 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
340 the next item is obtained from the buffer;
341 otherwise, when the input buffer is empty,
342 characters up to and including the next newline
343 character are read into the buffer. No characters
344 are available until the newline character is
346 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
347 the next block of data is read into this buffer.
348 \item[no-buffering] the next input item is read and returned.
351 For most implementations, physical files will normally be block-buffered
352 and terminals will normally be line-buffered. (the IO interface provides
353 operations for changing the default buffering of a handle tho.)
357 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
358 deriving (Eq, Ord, Show)
359 {- Read instance defined in IO. -}
363 Foreign import declarations to helper routines:
366 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO (Ptr ())
367 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
368 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
370 -- ToDo: use mallocBytes from PrelMarshal?
371 malloc :: Int -> IO (Ptr ())
375 then ioException (IOError Nothing ResourceExhausted
376 "malloc" "out of memory" Nothing)
379 foreign import "malloc" unsafe _malloc :: Int -> IO (Ptr ())
381 foreign import "libHS_cbits" "getBufSize" unsafe
382 getBufSize :: FILE_OBJECT -> IO Int
383 foreign import "libHS_cbits" "setBuf" unsafe
384 setBuf :: FILE_OBJECT -> Ptr () -> Int -> IO ()
388 %*********************************************************
390 \subsection{Exception datatype and operations}
392 %*********************************************************
396 = IOException IOException -- IO exceptions
397 | ArithException ArithException -- Arithmetic exceptions
398 | ArrayException ArrayException -- Array-related exceptions
399 | ErrorCall String -- Calls to 'error'
400 | NoMethodError String -- A non-existent method was invoked
401 | PatternMatchFail String -- A pattern match / guard failure
402 | RecSelError String -- Selecting a non-existent field
403 | RecConError String -- Field missing in record construction
404 | RecUpdError String -- Record doesn't contain updated field
405 | AssertionFailed String -- Assertions
406 | DynException Dynamic -- Dynamic exceptions
407 | AsyncException AsyncException -- Externally generated errors
408 | BlockedOnDeadMVar -- Blocking on a dead MVar
427 = IndexOutOfBounds String -- out-of-range array access
428 | UndefinedElement String -- evaluating an undefined element
431 stackOverflow, heapOverflow :: Exception -- for the RTS
432 stackOverflow = AsyncException StackOverflow
433 heapOverflow = AsyncException HeapOverflow
435 instance Show ArithException where
436 showsPrec _ Overflow = showString "arithmetic overflow"
437 showsPrec _ Underflow = showString "arithmetic underflow"
438 showsPrec _ LossOfPrecision = showString "loss of precision"
439 showsPrec _ DivideByZero = showString "divide by zero"
440 showsPrec _ Denormal = showString "denormal"
442 instance Show AsyncException where
443 showsPrec _ StackOverflow = showString "stack overflow"
444 showsPrec _ HeapOverflow = showString "heap overflow"
445 showsPrec _ ThreadKilled = showString "thread killed"
447 instance Show ArrayException where
448 showsPrec _ (IndexOutOfBounds s)
449 = showString "array index out of range"
450 . (if not (null s) then showString ": " . showString s
452 showsPrec _ (UndefinedElement s)
453 = showString "undefined array element"
454 . (if not (null s) then showString ": " . showString s
457 instance Show Exception where
458 showsPrec _ (IOException err) = shows err
459 showsPrec _ (ArithException err) = shows err
460 showsPrec _ (ArrayException err) = shows err
461 showsPrec _ (ErrorCall err) = showString err
462 showsPrec _ (NoMethodError err) = showString err
463 showsPrec _ (PatternMatchFail err) = showString err
464 showsPrec _ (RecSelError err) = showString err
465 showsPrec _ (RecConError err) = showString err
466 showsPrec _ (RecUpdError err) = showString err
467 showsPrec _ (AssertionFailed err) = showString err
468 showsPrec _ (DynException _err) = showString "unknown exception"
469 showsPrec _ (AsyncException e) = shows e
470 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
471 showsPrec _ (NonTermination) = showString "<<loop>>"
472 showsPrec _ (UserError err) = showString err
475 %*********************************************************
477 \subsection{Primitive throw}
479 %*********************************************************
482 throw :: Exception -> a
483 throw exception = raise# exception
485 ioError :: Exception -> IO a
486 ioError err = IO $ \s -> throw err s
488 ioException :: IOException -> IO a
489 ioException err = IO $ \s -> throw (IOException err) s
492 %*********************************************************
494 \subsection{Type @IOError@}
496 %*********************************************************
498 A value @IOError@ encode errors occurred in the @IO@ monad.
499 An @IOError@ records a more specific error type, a descriptive
500 string and maybe the handle that was used when the error was
504 type IOError = Exception
508 (Maybe Handle) -- the handle used by the action flagging the
510 IOErrorType -- what it was.
512 String -- error type specific information.
513 (Maybe FilePath) -- filename the error is related to.
515 instance Eq IOException where
516 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
517 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
520 = AlreadyExists | HardwareFault
521 | IllegalOperation | InappropriateType
522 | Interrupted | InvalidArgument
523 | NoSuchThing | OtherError
524 | PermissionDenied | ProtocolError
525 | ResourceBusy | ResourceExhausted
526 | ResourceVanished | SystemError
527 | TimeExpired | UnsatisfiedConstraints
528 | UnsupportedOperation
530 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
531 | ComError Int -- HRESULT
535 instance Show IOErrorType where
539 AlreadyExists -> "already exists"
540 HardwareFault -> "hardware fault"
541 IllegalOperation -> "illegal operation"
542 InappropriateType -> "inappropriate type"
543 Interrupted -> "interrupted"
544 InvalidArgument -> "invalid argument"
545 NoSuchThing -> "does not exist"
546 OtherError -> "failed"
547 PermissionDenied -> "permission denied"
548 ProtocolError -> "protocol error"
549 ResourceBusy -> "resource busy"
550 ResourceExhausted -> "resource exhausted"
551 ResourceVanished -> "resource vanished"
552 SystemError -> "system error"
553 TimeExpired -> "timeout"
554 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
555 UnsupportedOperation -> "unsupported operation"
557 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
558 ComError _ -> "COM error"
563 userError :: String -> IOError
564 userError str = UserError str
567 Predicates on IOError; little effort made on these so far...
571 isAlreadyExistsError :: IOError -> Bool
572 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
573 isAlreadyExistsError _ = False
575 isAlreadyInUseError :: IOError -> Bool
576 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
577 isAlreadyInUseError _ = False
579 isFullError :: IOError -> Bool
580 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
581 isFullError _ = False
583 isEOFError :: IOError -> Bool
584 isEOFError (IOException (IOError _ EOF _ _ _)) = True
587 isIllegalOperation :: IOError -> Bool
588 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
589 isIllegalOperation _ = False
591 isPermissionError :: IOError -> Bool
592 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
593 isPermissionError _ = False
595 isDoesNotExistError :: IOError -> Bool
596 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
597 isDoesNotExistError _ = False
599 isUserError :: IOError -> Bool
600 isUserError (UserError _) = True
601 isUserError _ = False
608 -- For now we give a fairly uninformative error message which just happens to
609 -- be like the ones that Hugs used to give.
610 instance Show IOException where
611 showsPrec p (IOError _ _ _ s _) = showString s . showChar '\n'
613 instance Show IOException where
614 showsPrec p (IOError hdl iot loc s fn) =
618 _ -> showString "\nAction: " . showString loc) .
622 _ -> showString "\nReason: " . showString s) .
625 Just name -> showString "\nFile: " . showString name)
630 Just h -> showString "\nHandle: " . showsPrec p h
635 The @String@ part of an @IOError@ is platform-dependent. However, to
636 provide a uniform mechanism for distinguishing among errors within
637 these broad categories, each platform-specific standard shall specify
638 the exact strings to be used for particular errors. For errors not
639 explicitly mentioned in the standard, any descriptive string may be
643 constructErrorAndFail :: String -> IO a
644 constructErrorAndFail call_site
645 = constructError call_site >>= \ io_error ->
646 ioError (IOException io_error)
648 constructErrorAndFailWithInfo :: String -> String -> IO a
649 constructErrorAndFailWithInfo call_site fn
650 = constructErrorMsg call_site (Just fn) >>= \ io_error ->
651 ioError (IOException io_error)
655 This doesn't seem to be documented/spelled out anywhere,
658 The implementation of the IO prelude uses various C stubs
659 to do the actual interaction with the OS. The bandwidth
660 \tr{C<->Haskell} is somewhat limited, so the general strategy
661 for flaggging any errors (apart from possibly using the
662 return code of the external call), is to set the @ghc_errtype@
663 to a value that is one of the \tr{#define}s in @includes/error.h@.
664 @ghc_errstr@ holds a character string providing error-specific
665 information. Error constructing functions will then reach out
666 and grab these values when generating
669 constructError :: String -> IO IOException
670 constructError call_site = constructErrorMsg call_site Nothing
672 constructErrorMsg :: String -> Maybe String -> IO IOException
673 constructErrorMsg call_site fn =
674 getErrType__ >>= \ errtype ->
675 getErrStr__ >>= \ str ->
678 case (errtype::Int) of
679 ERR_ALREADYEXISTS -> AlreadyExists
680 ERR_HARDWAREFAULT -> HardwareFault
681 ERR_ILLEGALOPERATION -> IllegalOperation
682 ERR_INAPPROPRIATETYPE -> InappropriateType
683 ERR_INTERRUPTED -> Interrupted
684 ERR_INVALIDARGUMENT -> InvalidArgument
685 ERR_NOSUCHTHING -> NoSuchThing
686 ERR_OTHERERROR -> OtherError
687 ERR_PERMISSIONDENIED -> PermissionDenied
688 ERR_PROTOCOLERROR -> ProtocolError
689 ERR_RESOURCEBUSY -> ResourceBusy
690 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
691 ERR_RESOURCEVANISHED -> ResourceVanished
692 ERR_SYSTEMERROR -> SystemError
693 ERR_TIMEEXPIRED -> TimeExpired
694 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
695 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
702 OtherError -> "(error code: " ++ show errtype ++ ")"
705 return (IOError Nothing iot call_site msg fn)