1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.28 2000/09/25 12:58:39 simonpj 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(..) )
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
226 = ErrorHandle IOException
235 -- File names are specified using @FilePath@, a OS-dependent
236 -- string that (hopefully, I guess) maps to an accessible file/object.
238 type FilePath = String
241 %*********************************************************
243 \subsection[Show-Handle]{Show instance for Handles}
245 %*********************************************************
248 -- handle types are 'show'ed when printing error msgs, so
249 -- we provide a more user-friendly Show instance for it
250 -- than the derived one.
251 instance Show Handle__Type where
254 ErrorHandle iot -> showString "error " . showsPrec p iot
255 ClosedHandle -> showString "closed"
256 SemiClosedHandle -> showString "semi-closed"
257 ReadHandle -> showString "readable"
258 WriteHandle -> showString "writeable"
259 AppendHandle -> showString "writeable (append)"
260 ReadWriteHandle -> showString "read-writeable"
262 instance Show Handle where
263 showsPrec p (Handle h) =
265 #if defined(__CONCURRENT_HASKELL__)
267 hdl_ = unsafePerformIO (primTakeMVar h)
269 -- (Big) SIGH: unfolded defn of takeMVar to avoid
270 -- an (oh-so) unfortunate module loop with PrelConc.
271 hdl_ = unsafePerformIO (IO $ \ s# ->
272 case h of { MVar h# ->
273 case takeMVar# h# s# of { (# s2# , r #) ->
277 hdl_ = unsafePerformIO (stToIO (readVar h))
281 showHdl (haType__ hdl_)
282 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
283 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
284 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
286 showHdl :: Handle__Type -> ShowS -> ShowS
289 ClosedHandle -> showsPrec p ht . showString "}\n"
290 ErrorHandle _ -> showsPrec p ht . showString "}\n"
293 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
296 NoBuffering -> showString "none"
297 LineBuffering -> showString "line"
298 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
299 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
302 def = unsafePerformIO (getBufSize fo)
305 %*********************************************************
307 \subsection[BufferMode]{Buffering modes}
309 %*********************************************************
311 Three kinds of buffering are supported: line-buffering,
312 block-buffering or no-buffering. These modes have the following
313 effects. For output, items are written out from the internal
314 buffer according to the buffer mode:
317 \item[line-buffering] the entire output buffer is written
318 out whenever a newline is output, the output buffer overflows,
319 a flush is issued, or the handle is closed.
321 \item[block-buffering] the entire output buffer is written out whenever
322 it overflows, a flush is issued, or the handle
325 \item[no-buffering] output is written immediately, and never stored
326 in the output buffer.
329 The output buffer is emptied as soon as it has been written out.
331 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
333 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
334 the next item is obtained from the buffer;
335 otherwise, when the input buffer is empty,
336 characters up to and including the next newline
337 character are read into the buffer. No characters
338 are available until the newline character is
340 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
341 the next block of data is read into this buffer.
342 \item[no-buffering] the next input item is read and returned.
345 For most implementations, physical files will normally be block-buffered
346 and terminals will normally be line-buffered. (the IO interface provides
347 operations for changing the default buffering of a handle tho.)
351 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
352 deriving (Eq, Ord, Show)
353 {- Read instance defined in IO. -}
357 Foreign import declarations to helper routines:
360 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
361 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
362 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
364 foreign import "libHS_cbits" "allocMemory__" unsafe
365 allocMemory__ :: Int -> IO Addr
366 foreign import "libHS_cbits" "getBufSize" unsafe
367 getBufSize :: FILE_OBJECT -> IO Int
368 foreign import "libHS_cbits" "setBuf" unsafe
369 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()
373 %*********************************************************
375 \subsection{Exception datatype and operations}
377 %*********************************************************
381 = IOException IOException -- IO exceptions
382 | ArithException ArithException -- Arithmetic exceptions
383 | ArrayException ArrayException -- Array-related exceptions
384 | ErrorCall String -- Calls to 'error'
385 | NoMethodError String -- A non-existent method was invoked
386 | PatternMatchFail String -- A pattern match / guard failure
387 | RecSelError String -- Selecting a non-existent field
388 | RecConError String -- Field missing in record construction
389 | RecUpdError String -- Record doesn't contain updated field
390 | AssertionFailed String -- Assertions
391 | DynException Dynamic -- Dynamic exceptions
392 | AsyncException AsyncException -- Externally generated errors
393 | PutFullMVar -- Put on a full MVar
394 | BlockedOnDeadMVar -- Blocking on a dead MVar
413 = IndexOutOfBounds String -- out-of-range array access
414 | UndefinedElement String -- evaluating an undefined element
417 stackOverflow, heapOverflow :: Exception -- for the RTS
418 stackOverflow = AsyncException StackOverflow
419 heapOverflow = AsyncException HeapOverflow
421 instance Show ArithException where
422 showsPrec _ Overflow = showString "arithmetic overflow"
423 showsPrec _ Underflow = showString "arithmetic underflow"
424 showsPrec _ LossOfPrecision = showString "loss of precision"
425 showsPrec _ DivideByZero = showString "divide by zero"
426 showsPrec _ Denormal = showString "denormal"
428 instance Show AsyncException where
429 showsPrec _ StackOverflow = showString "stack overflow"
430 showsPrec _ HeapOverflow = showString "heap overflow"
431 showsPrec _ ThreadKilled = showString "thread killed"
433 instance Show ArrayException where
434 showsPrec _ (IndexOutOfBounds s)
435 = showString "array index out of range"
436 . (if not (null s) then showString ": " . showString s
438 showsPrec _ (UndefinedElement s)
439 = showString "undefined array element"
440 . (if not (null s) then showString ": " . showString s
443 instance Show Exception where
444 showsPrec _ (IOException err) = shows err
445 showsPrec _ (ArithException err) = shows err
446 showsPrec _ (ArrayException err) = shows err
447 showsPrec _ (ErrorCall err) = showString err
448 showsPrec _ (NoMethodError err) = showString err
449 showsPrec _ (PatternMatchFail err) = showString err
450 showsPrec _ (RecSelError err) = showString err
451 showsPrec _ (RecConError err) = showString err
452 showsPrec _ (RecUpdError err) = showString err
453 showsPrec _ (AssertionFailed err) = showString err
454 showsPrec _ (DynException _err) = showString "unknown exception"
455 showsPrec _ (AsyncException e) = shows e
456 showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
457 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
458 showsPrec _ (NonTermination) = showString "<<loop>>"
459 showsPrec _ (UserError err) = showString err
462 %*********************************************************
464 \subsection{Primitive throw}
466 %*********************************************************
469 throw :: Exception -> a
470 throw exception = raise# exception
472 ioError :: Exception -> IO a
473 ioError err = IO $ \s -> throw err s
475 ioException :: IOException -> IO a
476 ioException err = IO $ \s -> throw (IOException err) s
479 %*********************************************************
481 \subsection{Type @IOError@}
483 %*********************************************************
485 A value @IOError@ encode errors occurred in the @IO@ monad.
486 An @IOError@ records a more specific error type, a descriptive
487 string and maybe the handle that was used when the error was
491 type IOError = Exception
495 (Maybe Handle) -- the handle used by the action flagging the
497 IOErrorType -- what it was.
499 String -- error type specific information.
501 instance Eq IOException where
502 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
503 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
506 = AlreadyExists | HardwareFault
507 | IllegalOperation | InappropriateType
508 | Interrupted | InvalidArgument
509 | NoSuchThing | OtherError
510 | PermissionDenied | ProtocolError
511 | ResourceBusy | ResourceExhausted
512 | ResourceVanished | SystemError
513 | TimeExpired | UnsatisfiedConstraints
514 | UnsupportedOperation
516 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
517 | ComError Int -- HRESULT
521 instance Show IOErrorType where
525 AlreadyExists -> "already exists"
526 HardwareFault -> "hardware fault"
527 IllegalOperation -> "illegal operation"
528 InappropriateType -> "inappropriate type"
529 Interrupted -> "interrupted"
530 InvalidArgument -> "invalid argument"
531 NoSuchThing -> "does not exist"
532 OtherError -> "failed"
533 PermissionDenied -> "permission denied"
534 ProtocolError -> "protocol error"
535 ResourceBusy -> "resource busy"
536 ResourceExhausted -> "resource exhausted"
537 ResourceVanished -> "resource vanished"
538 SystemError -> "system error"
539 TimeExpired -> "timeout"
540 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
541 UnsupportedOperation -> "unsupported operation"
543 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
544 ComError _ -> "COM error"
549 userError :: String -> IOError
550 userError str = UserError str
553 Predicates on IOError; little effort made on these so far...
557 isAlreadyExistsError :: IOError -> Bool
558 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _)) = True
559 isAlreadyExistsError _ = False
561 isAlreadyInUseError :: IOError -> Bool
562 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _)) = True
563 isAlreadyInUseError _ = False
565 isFullError :: IOError -> Bool
566 isFullError (IOException (IOError _ ResourceExhausted _ _)) = True
567 isFullError _ = False
569 isEOFError :: IOError -> Bool
570 isEOFError (IOException (IOError _ EOF _ _)) = True
573 isIllegalOperation :: IOError -> Bool
574 isIllegalOperation (IOException (IOError _ IllegalOperation _ _)) = True
575 isIllegalOperation _ = False
577 isPermissionError :: IOError -> Bool
578 isPermissionError (IOException (IOError _ PermissionDenied _ _)) = True
579 isPermissionError _ = False
581 isDoesNotExistError :: IOError -> Bool
582 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _)) = True
583 isDoesNotExistError _ = False
585 isUserError :: IOError -> Bool
586 isUserError (UserError _) = True
587 isUserError _ = False
594 -- For now we give a fairly uninformative error message which just happens to
595 -- be like the ones that Hugs used to give.
596 instance Show IOException where
597 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
599 instance Show IOException where
600 showsPrec p (IOError hdl iot loc s) =
605 _ -> showString "Action: " . showString loc . showChar '\n') .
609 _ -> showString "Reason: " . showString s)
614 Just h -> showString "Handle: " . showsPrec p h
619 The @String@ part of an @IOError@ is platform-dependent. However, to
620 provide a uniform mechanism for distinguishing among errors within
621 these broad categories, each platform-specific standard shall specify
622 the exact strings to be used for particular errors. For errors not
623 explicitly mentioned in the standard, any descriptive string may be
627 constructErrorAndFail :: String -> IO a
628 constructErrorAndFail call_site
629 = constructError call_site >>= \ io_error ->
630 ioError (IOException io_error)
632 constructErrorAndFailWithInfo :: String -> String -> IO a
633 constructErrorAndFailWithInfo call_site reason
634 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
635 ioError (IOException io_error)
639 This doesn't seem to be documented/spelled out anywhere,
642 The implementation of the IO prelude uses various C stubs
643 to do the actual interaction with the OS. The bandwidth
644 \tr{C<->Haskell} is somewhat limited, so the general strategy
645 for flaggging any errors (apart from possibly using the
646 return code of the external call), is to set the @ghc_errtype@
647 to a value that is one of the \tr{#define}s in @includes/error.h@.
648 @ghc_errstr@ holds a character string providing error-specific
649 information. Error constructing functions will then reach out
650 and grab these values when generating
653 constructError :: String -> IO IOException
654 constructError call_site = constructErrorMsg call_site Nothing
656 constructErrorMsg :: String -> Maybe String -> IO IOException
657 constructErrorMsg call_site reason =
658 getErrType__ >>= \ errtype ->
659 getErrStr__ >>= \ str ->
662 case (errtype::Int) of
663 ERR_ALREADYEXISTS -> AlreadyExists
664 ERR_HARDWAREFAULT -> HardwareFault
665 ERR_ILLEGALOPERATION -> IllegalOperation
666 ERR_INAPPROPRIATETYPE -> InappropriateType
667 ERR_INTERRUPTED -> Interrupted
668 ERR_INVALIDARGUMENT -> InvalidArgument
669 ERR_NOSUCHTHING -> NoSuchThing
670 ERR_OTHERERROR -> OtherError
671 ERR_PERMISSIONDENIED -> PermissionDenied
672 ERR_PROTOCOLERROR -> ProtocolError
673 ERR_RESOURCEBUSY -> ResourceBusy
674 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
675 ERR_RESOURCEVANISHED -> ResourceVanished
676 ERR_SYSTEMERROR -> SystemError
677 ERR_TIMEEXPIRED -> TimeExpired
678 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
679 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
686 OtherError -> "(error code: " ++ show errtype ++ ")"
692 return (IOError Nothing iot call_site msg)