1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.37 2001/02/27 13:38:58 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
98 failIO :: String -> IO a
99 failIO s = ioError (userError s)
101 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
102 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
104 bindIO :: IO a -> (a -> IO b) -> IO b
105 bindIO (IO m) k = IO ( \ s ->
107 (# new_s, a #) -> unIO (k a) new_s
110 returnIO :: a -> IO a
111 returnIO x = IO (\ s -> (# s, x #))
115 %*********************************************************
117 \subsection{Coercions to @ST@}
119 %*********************************************************
123 /* Hugs doesn't distinguish these types so no coercion required) */
125 -- stToIO :: (forall s. ST s a) -> IO a
126 stToIO :: ST RealWorld a -> IO a
129 ioToST :: IO a -> ST RealWorld a
130 ioToST (IO m) = (ST m)
134 %*********************************************************
136 \subsection{Unsafe @IO@ operations}
138 %*********************************************************
142 {-# NOINLINE unsafePerformIO #-}
143 unsafePerformIO :: IO a -> a
144 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
146 {-# NOINLINE unsafeInterleaveIO #-}
147 unsafeInterleaveIO :: IO a -> IO a
148 unsafeInterleaveIO (IO m)
150 r = case m s of (# _, res #) -> res
156 %*********************************************************
158 \subsection{Types @Handle@, @Handle__@}
160 %*********************************************************
162 The type for @Handle@ is defined rather than in @IOHandle@
163 module, as the @IOError@ type uses it..all operations over
164 a handles reside in @IOHandle@.
170 Sigh, the MVar ops in ConcBase depend on IO, the IO
171 representation here depend on MVars for handles (when
172 compiling in a concurrent way). Break the cycle by having
173 the definition of MVars go here:
176 data MVar a = MVar (MVar# RealWorld a)
178 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
179 instance Eq (MVar a) where
180 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
183 Double sigh - ForeignPtr is needed here too to break a cycle.
185 data ForeignPtr a = ForeignPtr ForeignObj#
186 instance CCallable (ForeignPtr a)
188 eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool
190 = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
192 foreign import "eqForeignObj" unsafe
193 primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
195 instance Eq (ForeignPtr a) where
196 p == q = eqForeignPtr p q
197 p /= q = not (eqForeignPtr p q)
198 #endif /* ndef __HUGS__ */
200 #if defined(__CONCURRENT_HASKELL__)
201 newtype Handle = Handle (MVar Handle__)
203 newtype Handle = Handle (MutableVar RealWorld Handle__)
206 instance Eq Handle where
207 (Handle h1) == (Handle h2) = h1 == h2
210 A Handle is represented by (a reference to) a record
211 containing the state of the I/O port/device. We record
212 the following pieces of info:
214 * type (read,write,closed etc.)
215 * pointer to the external file object.
217 * user-friendly name (usually the
218 FilePath used when IO.openFile was called)
220 Note: when a Handle is garbage collected, we want to flush its buffer
221 and close the OS file handle, so as to free up a (precious) resource.
225 haFO__ :: FILE_OBJECT,
226 haType__ :: Handle__Type,
227 haBufferMode__ :: BufferMode,
228 haFilePath__ :: FilePath,
229 haBuffers__ :: [Ptr ()]
233 Internally, we classify handles as being one
245 -- File names are specified using @FilePath@, a OS-dependent
246 -- string that (hopefully, I guess) maps to an accessible file/object.
248 type FilePath = String
251 %*********************************************************
253 \subsection[Show-Handle]{Show instance for Handles}
255 %*********************************************************
258 -- handle types are 'show'ed when printing error msgs, so
259 -- we provide a more user-friendly Show instance for it
260 -- than the derived one.
261 instance Show Handle__Type where
264 ClosedHandle -> showString "closed"
265 SemiClosedHandle -> showString "semi-closed"
266 ReadHandle -> showString "readable"
267 WriteHandle -> showString "writeable"
268 AppendHandle -> showString "writeable (append)"
269 ReadWriteHandle -> showString "read-writeable"
271 instance Show Handle where
272 showsPrec p (Handle h) =
274 #if defined(__CONCURRENT_HASKELL__)
276 hdl_ = unsafePerformIO (primTakeMVar h)
278 -- (Big) SIGH: unfolded defn of takeMVar to avoid
279 -- an (oh-so) unfortunate module loop with PrelConc.
280 hdl_ = unsafePerformIO (IO $ \ s# ->
281 case h of { MVar h# ->
282 case takeMVar# h# s# of { (# s2# , r #) ->
283 case putMVar# h# r s2# of { s3# ->
287 hdl_ = unsafePerformIO (stToIO (readVar h))
291 showHdl (haType__ hdl_)
292 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
293 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
294 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
296 showHdl :: Handle__Type -> ShowS -> ShowS
299 ClosedHandle -> showsPrec p ht . showString "}\n"
302 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
305 NoBuffering -> showString "none"
306 LineBuffering -> showString "line"
307 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
308 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
311 def = unsafePerformIO (getBufSize fo)
314 %*********************************************************
316 \subsection[BufferMode]{Buffering modes}
318 %*********************************************************
320 Three kinds of buffering are supported: line-buffering,
321 block-buffering or no-buffering. These modes have the following
322 effects. For output, items are written out from the internal
323 buffer according to the buffer mode:
326 \item[line-buffering] the entire output buffer is written
327 out whenever a newline is output, the output buffer overflows,
328 a flush is issued, or the handle is closed.
330 \item[block-buffering] the entire output buffer is written out whenever
331 it overflows, a flush is issued, or the handle
334 \item[no-buffering] output is written immediately, and never stored
335 in the output buffer.
338 The output buffer is emptied as soon as it has been written out.
340 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
342 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
343 the next item is obtained from the buffer;
344 otherwise, when the input buffer is empty,
345 characters up to and including the next newline
346 character are read into the buffer. No characters
347 are available until the newline character is
349 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
350 the next block of data is read into this buffer.
351 \item[no-buffering] the next input item is read and returned.
354 For most implementations, physical files will normally be block-buffered
355 and terminals will normally be line-buffered. (the IO interface provides
356 operations for changing the default buffering of a handle tho.)
360 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
361 deriving (Eq, Ord, Show)
362 {- Read instance defined in IO. -}
366 Foreign import declarations to helper routines:
369 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO (Ptr ())
370 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
371 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
373 -- ToDo: use mallocBytes from PrelMarshal?
374 malloc :: Int -> IO (Ptr ())
378 then ioException (IOError Nothing ResourceExhausted
379 "malloc" "out of memory" Nothing)
382 foreign import "malloc" unsafe _malloc :: Int -> IO (Ptr ())
384 foreign import "libHS_cbits" "getBufSize" unsafe
385 getBufSize :: FILE_OBJECT -> IO Int
386 foreign import "libHS_cbits" "setBuf" unsafe
387 setBuf :: FILE_OBJECT -> Ptr () -> Int -> IO ()
391 %*********************************************************
393 \subsection{Exception datatype and operations}
395 %*********************************************************
399 = IOException IOException -- IO exceptions
400 | ArithException ArithException -- Arithmetic exceptions
401 | ArrayException ArrayException -- Array-related exceptions
402 | ErrorCall String -- Calls to 'error'
403 | NoMethodError String -- A non-existent method was invoked
404 | PatternMatchFail String -- A pattern match / guard failure
405 | RecSelError String -- Selecting a non-existent field
406 | RecConError String -- Field missing in record construction
407 | RecUpdError String -- Record doesn't contain updated field
408 | AssertionFailed String -- Assertions
409 | DynException Dynamic -- Dynamic exceptions
410 | AsyncException AsyncException -- Externally generated errors
411 | BlockedOnDeadMVar -- Blocking on a dead MVar
430 = IndexOutOfBounds String -- out-of-range array access
431 | UndefinedElement String -- evaluating an undefined element
434 stackOverflow, heapOverflow :: Exception -- for the RTS
435 stackOverflow = AsyncException StackOverflow
436 heapOverflow = AsyncException HeapOverflow
438 instance Show ArithException where
439 showsPrec _ Overflow = showString "arithmetic overflow"
440 showsPrec _ Underflow = showString "arithmetic underflow"
441 showsPrec _ LossOfPrecision = showString "loss of precision"
442 showsPrec _ DivideByZero = showString "divide by zero"
443 showsPrec _ Denormal = showString "denormal"
445 instance Show AsyncException where
446 showsPrec _ StackOverflow = showString "stack overflow"
447 showsPrec _ HeapOverflow = showString "heap overflow"
448 showsPrec _ ThreadKilled = showString "thread killed"
450 instance Show ArrayException where
451 showsPrec _ (IndexOutOfBounds s)
452 = showString "array index out of range"
453 . (if not (null s) then showString ": " . showString s
455 showsPrec _ (UndefinedElement s)
456 = showString "undefined array element"
457 . (if not (null s) then showString ": " . showString s
460 instance Show Exception where
461 showsPrec _ (IOException err) = shows err
462 showsPrec _ (ArithException err) = shows err
463 showsPrec _ (ArrayException err) = shows err
464 showsPrec _ (ErrorCall err) = showString err
465 showsPrec _ (NoMethodError err) = showString err
466 showsPrec _ (PatternMatchFail err) = showString err
467 showsPrec _ (RecSelError err) = showString err
468 showsPrec _ (RecConError err) = showString err
469 showsPrec _ (RecUpdError err) = showString err
470 showsPrec _ (AssertionFailed err) = showString err
471 showsPrec _ (DynException _err) = showString "unknown exception"
472 showsPrec _ (AsyncException e) = shows e
473 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
474 showsPrec _ (NonTermination) = showString "<<loop>>"
475 showsPrec _ (UserError err) = showString err
478 %*********************************************************
480 \subsection{Primitive throw}
482 %*********************************************************
485 throw :: Exception -> a
486 throw exception = raise# exception
488 ioError :: Exception -> IO a
489 ioError err = IO $ \s -> throw err s
491 ioException :: IOException -> IO a
492 ioException err = IO $ \s -> throw (IOException err) s
495 %*********************************************************
497 \subsection{Type @IOError@}
499 %*********************************************************
501 A value @IOError@ encode errors occurred in the @IO@ monad.
502 An @IOError@ records a more specific error type, a descriptive
503 string and maybe the handle that was used when the error was
507 type IOError = Exception
511 (Maybe Handle) -- the handle used by the action flagging the
513 IOErrorType -- what it was.
515 String -- error type specific information.
516 (Maybe FilePath) -- filename the error is related to.
518 instance Eq IOException where
519 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
520 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
523 = AlreadyExists | HardwareFault
524 | IllegalOperation | InappropriateType
525 | Interrupted | InvalidArgument
526 | NoSuchThing | OtherError
527 | PermissionDenied | ProtocolError
528 | ResourceBusy | ResourceExhausted
529 | ResourceVanished | SystemError
530 | TimeExpired | UnsatisfiedConstraints
531 | UnsupportedOperation
533 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
534 | ComError Int -- HRESULT
538 instance Show IOErrorType where
542 AlreadyExists -> "already exists"
543 HardwareFault -> "hardware fault"
544 IllegalOperation -> "illegal operation"
545 InappropriateType -> "inappropriate type"
546 Interrupted -> "interrupted"
547 InvalidArgument -> "invalid argument"
548 NoSuchThing -> "does not exist"
549 OtherError -> "failed"
550 PermissionDenied -> "permission denied"
551 ProtocolError -> "protocol error"
552 ResourceBusy -> "resource busy"
553 ResourceExhausted -> "resource exhausted"
554 ResourceVanished -> "resource vanished"
555 SystemError -> "system error"
556 TimeExpired -> "timeout"
557 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
558 UnsupportedOperation -> "unsupported operation"
560 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
561 ComError _ -> "COM error"
566 userError :: String -> IOError
567 userError str = UserError str
570 Predicates on IOError; little effort made on these so far...
574 isAlreadyExistsError :: IOError -> Bool
575 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
576 isAlreadyExistsError _ = False
578 isAlreadyInUseError :: IOError -> Bool
579 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
580 isAlreadyInUseError _ = False
582 isFullError :: IOError -> Bool
583 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
584 isFullError _ = False
586 isEOFError :: IOError -> Bool
587 isEOFError (IOException (IOError _ EOF _ _ _)) = True
590 isIllegalOperation :: IOError -> Bool
591 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
592 isIllegalOperation _ = False
594 isPermissionError :: IOError -> Bool
595 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
596 isPermissionError _ = False
598 isDoesNotExistError :: IOError -> Bool
599 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
600 isDoesNotExistError _ = False
602 isUserError :: IOError -> Bool
603 isUserError (UserError _) = True
604 isUserError _ = False
611 -- For now we give a fairly uninformative error message which just happens to
612 -- be like the ones that Hugs used to give.
613 instance Show IOException where
614 showsPrec p (IOError _ _ _ s _) = showString s . showChar '\n'
616 instance Show IOException where
617 showsPrec p (IOError hdl iot loc s fn) =
621 _ -> showString "\nAction: " . showString loc) .
625 _ -> showString "\nReason: " . showString s) .
628 Just name -> showString "\nFile: " . showString name)
633 Just h -> showString "\nHandle: " . showsPrec p h
638 The @String@ part of an @IOError@ is platform-dependent. However, to
639 provide a uniform mechanism for distinguishing among errors within
640 these broad categories, each platform-specific standard shall specify
641 the exact strings to be used for particular errors. For errors not
642 explicitly mentioned in the standard, any descriptive string may be
646 constructErrorAndFail :: String -> IO a
647 constructErrorAndFail call_site
648 = constructError call_site >>= \ io_error ->
649 ioError (IOException io_error)
651 constructErrorAndFailWithInfo :: String -> String -> IO a
652 constructErrorAndFailWithInfo call_site fn
653 = constructErrorMsg call_site (Just fn) >>= \ io_error ->
654 ioError (IOException io_error)
658 This doesn't seem to be documented/spelled out anywhere,
661 The implementation of the IO prelude uses various C stubs
662 to do the actual interaction with the OS. The bandwidth
663 \tr{C<->Haskell} is somewhat limited, so the general strategy
664 for flaggging any errors (apart from possibly using the
665 return code of the external call), is to set the @ghc_errtype@
666 to a value that is one of the \tr{#define}s in @includes/error.h@.
667 @ghc_errstr@ holds a character string providing error-specific
668 information. Error constructing functions will then reach out
669 and grab these values when generating
672 constructError :: String -> IO IOException
673 constructError call_site = constructErrorMsg call_site Nothing
675 constructErrorMsg :: String -> Maybe String -> IO IOException
676 constructErrorMsg call_site fn =
677 getErrType__ >>= \ errtype ->
678 getErrStr__ >>= \ str ->
681 case (errtype::Int) of
682 ERR_ALREADYEXISTS -> AlreadyExists
683 ERR_HARDWAREFAULT -> HardwareFault
684 ERR_ILLEGALOPERATION -> IllegalOperation
685 ERR_INAPPROPRIATETYPE -> InappropriateType
686 ERR_INTERRUPTED -> Interrupted
687 ERR_INVALIDARGUMENT -> InvalidArgument
688 ERR_NOSUCHTHING -> NoSuchThing
689 ERR_OTHERERROR -> OtherError
690 ERR_PERMISSIONDENIED -> PermissionDenied
691 ERR_PROTOCOLERROR -> ProtocolError
692 ERR_RESOURCEBUSY -> ResourceBusy
693 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
694 ERR_RESOURCEVANISHED -> ResourceVanished
695 ERR_SYSTEMERROR -> SystemError
696 ERR_TIMEEXPIRED -> TimeExpired
697 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
698 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
705 OtherError -> "(error code: " ++ show errtype ++ ")"
708 return (IOError Nothing iot call_site msg fn)