1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.29 2000/11/07 10:42:56 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 ( fromInteger ) -- Integer literals
25 import PrelMaybe ( Maybe(..) )
26 import PrelAddr ( Addr(..), nullAddr )
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 ForeignObj
46 #define FILE_OBJECT Addr
50 %*********************************************************
52 \subsection{The @IO@ monad}
54 %*********************************************************
56 The IO Monad is just an instance of the ST monad, where the state is
57 the real world. We use the exception mechanism (in PrelException) to
58 implement IO exceptions.
60 NOTE: The IO representation is deeply wired in to various parts of the
61 system. The following list may or may not be exhaustive:
63 Compiler - types of various primitives in PrimOp.lhs
65 RTS - forceIO (StgMiscClosures.hc)
66 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
68 - raiseAsync (Schedule.c)
70 Prelude - PrelIOBase.lhs, and several other places including
73 Libraries - parts of hslibs/lang.
79 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
81 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
84 instance Functor IO where
85 fmap f x = x >>= (return . f)
87 instance Monad IO where
91 m >> k = m >>= \ _ -> k
95 fail s = error s -- not ioError?
97 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
98 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
100 bindIO :: IO a -> (a -> IO b) -> IO b
101 bindIO (IO m) k = IO ( \ s ->
103 (# new_s, a #) -> unIO (k a) new_s
106 returnIO :: a -> IO a
107 returnIO x = IO (\ s -> (# s, x #))
111 %*********************************************************
113 \subsection{Coercions to @ST@}
115 %*********************************************************
119 /* Hugs doesn't distinguish these types so no coercion required) */
121 stToIO :: ST RealWorld a -> IO a
122 stToIO (ST m) = (IO m)
124 ioToST :: IO a -> ST RealWorld a
125 ioToST (IO m) = (ST m)
129 %*********************************************************
131 \subsection{Unsafe @IO@ operations}
133 %*********************************************************
137 {-# NOINLINE unsafePerformIO #-}
138 unsafePerformIO :: IO a -> a
139 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
141 unsafeInterleaveIO :: IO a -> IO a
142 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
146 %*********************************************************
148 \subsection{Types @Handle@, @Handle__@}
150 %*********************************************************
152 The type for @Handle@ is defined rather than in @IOHandle@
153 module, as the @IOError@ type uses it..all operations over
154 a handles reside in @IOHandle@.
160 Sigh, the MVar ops in ConcBase depend on IO, the IO
161 representation here depend on MVars for handles (when
162 compiling in a concurrent way). Break the cycle by having
163 the definition of MVars go here:
166 data MVar a = MVar (MVar# RealWorld a)
168 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
169 instance Eq (MVar a) where
170 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
173 Double sigh - ForeignObj is needed here too to break a cycle.
175 data ForeignObj = ForeignObj ForeignObj# -- another one
176 instance CCallable ForeignObj
178 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
180 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
182 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
184 instance Eq ForeignObj where
185 p == q = eqForeignObj p q
186 p /= q = not (eqForeignObj p q)
187 #endif /* ndef __HUGS__ */
189 #if defined(__CONCURRENT_HASKELL__)
190 newtype Handle = Handle (MVar Handle__)
192 newtype Handle = Handle (MutableVar RealWorld Handle__)
195 instance Eq Handle where
196 (Handle h1) == (Handle h2) = h1 == h2
199 A Handle is represented by (a reference to) a record
200 containing the state of the I/O port/device. We record
201 the following pieces of info:
203 * type (read,write,closed etc.)
204 * pointer to the external file object.
206 * user-friendly name (usually the
207 FilePath used when IO.openFile was called)
209 Note: when a Handle is garbage collected, we want to flush its buffer
210 and close the OS file handle, so as to free up a (precious) resource.
214 haFO__ :: FILE_OBJECT,
215 haType__ :: Handle__Type,
216 haBufferMode__ :: BufferMode,
217 haFilePath__ :: FilePath,
218 haBuffers__ :: [Addr]
222 Internally, we classify handles as being one
234 -- File names are specified using @FilePath@, a OS-dependent
235 -- string that (hopefully, I guess) maps to an accessible file/object.
237 type FilePath = String
240 %*********************************************************
242 \subsection[Show-Handle]{Show instance for Handles}
244 %*********************************************************
247 -- handle types are 'show'ed when printing error msgs, so
248 -- we provide a more user-friendly Show instance for it
249 -- than the derived one.
250 instance Show Handle__Type where
253 ClosedHandle -> showString "closed"
254 SemiClosedHandle -> showString "semi-closed"
255 ReadHandle -> showString "readable"
256 WriteHandle -> showString "writeable"
257 AppendHandle -> showString "writeable (append)"
258 ReadWriteHandle -> showString "read-writeable"
260 instance Show Handle where
261 showsPrec p (Handle h) =
263 #if defined(__CONCURRENT_HASKELL__)
265 hdl_ = unsafePerformIO (primTakeMVar h)
267 -- (Big) SIGH: unfolded defn of takeMVar to avoid
268 -- an (oh-so) unfortunate module loop with PrelConc.
269 hdl_ = unsafePerformIO (IO $ \ s# ->
270 case h of { MVar h# ->
271 case takeMVar# h# s# of { (# s2# , r #) ->
275 hdl_ = unsafePerformIO (stToIO (readVar h))
279 showHdl (haType__ hdl_)
280 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
281 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
282 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
284 showHdl :: Handle__Type -> ShowS -> ShowS
287 ClosedHandle -> showsPrec p ht . showString "}\n"
290 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
293 NoBuffering -> showString "none"
294 LineBuffering -> showString "line"
295 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
296 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
299 def = unsafePerformIO (getBufSize fo)
302 %*********************************************************
304 \subsection[BufferMode]{Buffering modes}
306 %*********************************************************
308 Three kinds of buffering are supported: line-buffering,
309 block-buffering or no-buffering. These modes have the following
310 effects. For output, items are written out from the internal
311 buffer according to the buffer mode:
314 \item[line-buffering] the entire output buffer is written
315 out whenever a newline is output, the output buffer overflows,
316 a flush is issued, or the handle is closed.
318 \item[block-buffering] the entire output buffer is written out whenever
319 it overflows, a flush is issued, or the handle
322 \item[no-buffering] output is written immediately, and never stored
323 in the output buffer.
326 The output buffer is emptied as soon as it has been written out.
328 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
330 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
331 the next item is obtained from the buffer;
332 otherwise, when the input buffer is empty,
333 characters up to and including the next newline
334 character are read into the buffer. No characters
335 are available until the newline character is
337 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
338 the next block of data is read into this buffer.
339 \item[no-buffering] the next input item is read and returned.
342 For most implementations, physical files will normally be block-buffered
343 and terminals will normally be line-buffered. (the IO interface provides
344 operations for changing the default buffering of a handle tho.)
348 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
349 deriving (Eq, Ord, Show)
350 {- Read instance defined in IO. -}
354 Foreign import declarations to helper routines:
357 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
358 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
359 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
361 malloc :: Int -> IO Addr
365 then ioException (IOError Nothing ResourceExhausted "malloc" "")
368 foreign import "malloc" unsafe _malloc :: Int -> IO Addr
370 foreign import "libHS_cbits" "getBufSize" unsafe
371 getBufSize :: FILE_OBJECT -> IO Int
372 foreign import "libHS_cbits" "setBuf" unsafe
373 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()
377 %*********************************************************
379 \subsection{Exception datatype and operations}
381 %*********************************************************
385 = IOException IOException -- IO exceptions
386 | ArithException ArithException -- Arithmetic exceptions
387 | ArrayException ArrayException -- Array-related exceptions
388 | ErrorCall String -- Calls to 'error'
389 | NoMethodError String -- A non-existent method was invoked
390 | PatternMatchFail String -- A pattern match / guard failure
391 | RecSelError String -- Selecting a non-existent field
392 | RecConError String -- Field missing in record construction
393 | RecUpdError String -- Record doesn't contain updated field
394 | AssertionFailed String -- Assertions
395 | DynException Dynamic -- Dynamic exceptions
396 | AsyncException AsyncException -- Externally generated errors
397 | PutFullMVar -- Put on a full MVar
398 | BlockedOnDeadMVar -- Blocking on a dead MVar
417 = IndexOutOfBounds String -- out-of-range array access
418 | UndefinedElement String -- evaluating an undefined element
421 stackOverflow, heapOverflow :: Exception -- for the RTS
422 stackOverflow = AsyncException StackOverflow
423 heapOverflow = AsyncException HeapOverflow
425 instance Show ArithException where
426 showsPrec _ Overflow = showString "arithmetic overflow"
427 showsPrec _ Underflow = showString "arithmetic underflow"
428 showsPrec _ LossOfPrecision = showString "loss of precision"
429 showsPrec _ DivideByZero = showString "divide by zero"
430 showsPrec _ Denormal = showString "denormal"
432 instance Show AsyncException where
433 showsPrec _ StackOverflow = showString "stack overflow"
434 showsPrec _ HeapOverflow = showString "heap overflow"
435 showsPrec _ ThreadKilled = showString "thread killed"
437 instance Show ArrayException where
438 showsPrec _ (IndexOutOfBounds s)
439 = showString "array index out of range"
440 . (if not (null s) then showString ": " . showString s
442 showsPrec _ (UndefinedElement s)
443 = showString "undefined array element"
444 . (if not (null s) then showString ": " . showString s
447 instance Show Exception where
448 showsPrec _ (IOException err) = shows err
449 showsPrec _ (ArithException err) = shows err
450 showsPrec _ (ArrayException err) = shows err
451 showsPrec _ (ErrorCall err) = showString err
452 showsPrec _ (NoMethodError err) = showString err
453 showsPrec _ (PatternMatchFail err) = showString err
454 showsPrec _ (RecSelError err) = showString err
455 showsPrec _ (RecConError err) = showString err
456 showsPrec _ (RecUpdError err) = showString err
457 showsPrec _ (AssertionFailed err) = showString err
458 showsPrec _ (DynException _err) = showString "unknown exception"
459 showsPrec _ (AsyncException e) = shows e
460 showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
461 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
462 showsPrec _ (NonTermination) = showString "<<loop>>"
463 showsPrec _ (UserError err) = showString err
466 %*********************************************************
468 \subsection{Primitive throw}
470 %*********************************************************
473 throw :: Exception -> a
474 throw exception = raise# exception
476 ioError :: Exception -> IO a
477 ioError err = IO $ \s -> throw err s
479 ioException :: IOException -> IO a
480 ioException err = IO $ \s -> throw (IOException err) s
483 %*********************************************************
485 \subsection{Type @IOError@}
487 %*********************************************************
489 A value @IOError@ encode errors occurred in the @IO@ monad.
490 An @IOError@ records a more specific error type, a descriptive
491 string and maybe the handle that was used when the error was
495 type IOError = Exception
499 (Maybe Handle) -- the handle used by the action flagging the
501 IOErrorType -- what it was.
503 String -- error type specific information.
505 instance Eq IOException where
506 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
507 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
510 = AlreadyExists | HardwareFault
511 | IllegalOperation | InappropriateType
512 | Interrupted | InvalidArgument
513 | NoSuchThing | OtherError
514 | PermissionDenied | ProtocolError
515 | ResourceBusy | ResourceExhausted
516 | ResourceVanished | SystemError
517 | TimeExpired | UnsatisfiedConstraints
518 | UnsupportedOperation
520 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
521 | ComError Int -- HRESULT
525 instance Show IOErrorType where
529 AlreadyExists -> "already exists"
530 HardwareFault -> "hardware fault"
531 IllegalOperation -> "illegal operation"
532 InappropriateType -> "inappropriate type"
533 Interrupted -> "interrupted"
534 InvalidArgument -> "invalid argument"
535 NoSuchThing -> "does not exist"
536 OtherError -> "failed"
537 PermissionDenied -> "permission denied"
538 ProtocolError -> "protocol error"
539 ResourceBusy -> "resource busy"
540 ResourceExhausted -> "resource exhausted"
541 ResourceVanished -> "resource vanished"
542 SystemError -> "system error"
543 TimeExpired -> "timeout"
544 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
545 UnsupportedOperation -> "unsupported operation"
547 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
548 ComError _ -> "COM error"
553 userError :: String -> IOError
554 userError str = UserError str
557 Predicates on IOError; little effort made on these so far...
561 isAlreadyExistsError :: IOError -> Bool
562 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _)) = True
563 isAlreadyExistsError _ = False
565 isAlreadyInUseError :: IOError -> Bool
566 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _)) = True
567 isAlreadyInUseError _ = False
569 isFullError :: IOError -> Bool
570 isFullError (IOException (IOError _ ResourceExhausted _ _)) = True
571 isFullError _ = False
573 isEOFError :: IOError -> Bool
574 isEOFError (IOException (IOError _ EOF _ _)) = True
577 isIllegalOperation :: IOError -> Bool
578 isIllegalOperation (IOException (IOError _ IllegalOperation _ _)) = True
579 isIllegalOperation _ = False
581 isPermissionError :: IOError -> Bool
582 isPermissionError (IOException (IOError _ PermissionDenied _ _)) = True
583 isPermissionError _ = False
585 isDoesNotExistError :: IOError -> Bool
586 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _)) = True
587 isDoesNotExistError _ = False
589 isUserError :: IOError -> Bool
590 isUserError (UserError _) = True
591 isUserError _ = False
598 -- For now we give a fairly uninformative error message which just happens to
599 -- be like the ones that Hugs used to give.
600 instance Show IOException where
601 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
603 instance Show IOException where
604 showsPrec p (IOError hdl iot loc s) =
609 _ -> showString "Action: " . showString loc . showChar '\n') .
613 _ -> showString "Reason: " . showString s)
618 Just h -> showString "Handle: " . showsPrec p h
623 The @String@ part of an @IOError@ is platform-dependent. However, to
624 provide a uniform mechanism for distinguishing among errors within
625 these broad categories, each platform-specific standard shall specify
626 the exact strings to be used for particular errors. For errors not
627 explicitly mentioned in the standard, any descriptive string may be
631 constructErrorAndFail :: String -> IO a
632 constructErrorAndFail call_site
633 = constructError call_site >>= \ io_error ->
634 ioError (IOException io_error)
636 constructErrorAndFailWithInfo :: String -> String -> IO a
637 constructErrorAndFailWithInfo call_site reason
638 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
639 ioError (IOException io_error)
643 This doesn't seem to be documented/spelled out anywhere,
646 The implementation of the IO prelude uses various C stubs
647 to do the actual interaction with the OS. The bandwidth
648 \tr{C<->Haskell} is somewhat limited, so the general strategy
649 for flaggging any errors (apart from possibly using the
650 return code of the external call), is to set the @ghc_errtype@
651 to a value that is one of the \tr{#define}s in @includes/error.h@.
652 @ghc_errstr@ holds a character string providing error-specific
653 information. Error constructing functions will then reach out
654 and grab these values when generating
657 constructError :: String -> IO IOException
658 constructError call_site = constructErrorMsg call_site Nothing
660 constructErrorMsg :: String -> Maybe String -> IO IOException
661 constructErrorMsg call_site reason =
662 getErrType__ >>= \ errtype ->
663 getErrStr__ >>= \ str ->
666 case (errtype::Int) of
667 ERR_ALREADYEXISTS -> AlreadyExists
668 ERR_HARDWAREFAULT -> HardwareFault
669 ERR_ILLEGALOPERATION -> IllegalOperation
670 ERR_INAPPROPRIATETYPE -> InappropriateType
671 ERR_INTERRUPTED -> Interrupted
672 ERR_INVALIDARGUMENT -> InvalidArgument
673 ERR_NOSUCHTHING -> NoSuchThing
674 ERR_OTHERERROR -> OtherError
675 ERR_PERMISSIONDENIED -> PermissionDenied
676 ERR_PROTOCOLERROR -> ProtocolError
677 ERR_RESOURCEBUSY -> ResourceBusy
678 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
679 ERR_RESOURCEVANISHED -> ResourceVanished
680 ERR_SYSTEMERROR -> SystemError
681 ERR_TIMEEXPIRED -> TimeExpired
682 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
683 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
690 OtherError -> "(error code: " ++ show errtype ++ ")"
696 return (IOError Nothing iot call_site msg)