1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.33 2001/02/06 11:42:30 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(..) )
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 :: ST RealWorld a -> IO a
123 stToIO (ST m) = (IO m)
125 ioToST :: IO a -> ST RealWorld a
126 ioToST (IO m) = (ST m)
130 %*********************************************************
132 \subsection{Unsafe @IO@ operations}
134 %*********************************************************
138 {-# NOINLINE unsafePerformIO #-}
139 unsafePerformIO :: IO a -> a
140 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
142 unsafeInterleaveIO :: IO a -> IO a
143 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
147 %*********************************************************
149 \subsection{Types @Handle@, @Handle__@}
151 %*********************************************************
153 The type for @Handle@ is defined rather than in @IOHandle@
154 module, as the @IOError@ type uses it..all operations over
155 a handles reside in @IOHandle@.
161 Sigh, the MVar ops in ConcBase depend on IO, the IO
162 representation here depend on MVars for handles (when
163 compiling in a concurrent way). Break the cycle by having
164 the definition of MVars go here:
167 data MVar a = MVar (MVar# RealWorld a)
169 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
170 instance Eq (MVar a) where
171 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
174 Double sigh - ForeignPtr is needed here too to break a cycle.
176 data ForeignPtr a = ForeignPtr ForeignObj#
177 instance CCallable (ForeignPtr a)
179 eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool
181 = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
183 foreign import "eqForeignObj" unsafe
184 primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
186 instance Eq (ForeignPtr a) where
187 p == q = eqForeignPtr p q
188 p /= q = not (eqForeignPtr p q)
189 #endif /* ndef __HUGS__ */
191 #if defined(__CONCURRENT_HASKELL__)
192 newtype Handle = Handle (MVar Handle__)
194 newtype Handle = Handle (MutableVar RealWorld Handle__)
197 instance Eq Handle where
198 (Handle h1) == (Handle h2) = h1 == h2
201 A Handle is represented by (a reference to) a record
202 containing the state of the I/O port/device. We record
203 the following pieces of info:
205 * type (read,write,closed etc.)
206 * pointer to the external file object.
208 * user-friendly name (usually the
209 FilePath used when IO.openFile was called)
211 Note: when a Handle is garbage collected, we want to flush its buffer
212 and close the OS file handle, so as to free up a (precious) resource.
216 haFO__ :: FILE_OBJECT,
217 haType__ :: Handle__Type,
218 haBufferMode__ :: BufferMode,
219 haFilePath__ :: FilePath,
220 haBuffers__ :: [Ptr ()]
224 Internally, we classify handles as being one
236 -- File names are specified using @FilePath@, a OS-dependent
237 -- string that (hopefully, I guess) maps to an accessible file/object.
239 type FilePath = String
242 %*********************************************************
244 \subsection[Show-Handle]{Show instance for Handles}
246 %*********************************************************
249 -- handle types are 'show'ed when printing error msgs, so
250 -- we provide a more user-friendly Show instance for it
251 -- than the derived one.
252 instance Show Handle__Type where
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 #) ->
274 case putMVar# h# r s2# of { s3# ->
278 hdl_ = unsafePerformIO (stToIO (readVar h))
282 showHdl (haType__ hdl_)
283 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
284 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
285 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
287 showHdl :: Handle__Type -> ShowS -> ShowS
290 ClosedHandle -> 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 (Ptr ())
361 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
362 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
364 -- ToDo: use mallocBytes from PrelMarshal?
365 malloc :: Int -> IO (Ptr ())
369 then ioException (IOError Nothing ResourceExhausted
370 "malloc" "out of memory" Nothing)
373 foreign import "malloc" unsafe _malloc :: Int -> IO (Ptr ())
375 foreign import "libHS_cbits" "getBufSize" unsafe
376 getBufSize :: FILE_OBJECT -> IO Int
377 foreign import "libHS_cbits" "setBuf" unsafe
378 setBuf :: FILE_OBJECT -> Ptr () -> Int -> IO ()
382 %*********************************************************
384 \subsection{Exception datatype and operations}
386 %*********************************************************
390 = IOException IOException -- IO exceptions
391 | ArithException ArithException -- Arithmetic exceptions
392 | ArrayException ArrayException -- Array-related exceptions
393 | ErrorCall String -- Calls to 'error'
394 | NoMethodError String -- A non-existent method was invoked
395 | PatternMatchFail String -- A pattern match / guard failure
396 | RecSelError String -- Selecting a non-existent field
397 | RecConError String -- Field missing in record construction
398 | RecUpdError String -- Record doesn't contain updated field
399 | AssertionFailed String -- Assertions
400 | DynException Dynamic -- Dynamic exceptions
401 | AsyncException AsyncException -- Externally generated errors
402 | PutFullMVar -- Put on a full MVar
403 | BlockedOnDeadMVar -- Blocking on a dead MVar
422 = IndexOutOfBounds String -- out-of-range array access
423 | UndefinedElement String -- evaluating an undefined element
426 stackOverflow, heapOverflow :: Exception -- for the RTS
427 stackOverflow = AsyncException StackOverflow
428 heapOverflow = AsyncException HeapOverflow
430 instance Show ArithException where
431 showsPrec _ Overflow = showString "arithmetic overflow"
432 showsPrec _ Underflow = showString "arithmetic underflow"
433 showsPrec _ LossOfPrecision = showString "loss of precision"
434 showsPrec _ DivideByZero = showString "divide by zero"
435 showsPrec _ Denormal = showString "denormal"
437 instance Show AsyncException where
438 showsPrec _ StackOverflow = showString "stack overflow"
439 showsPrec _ HeapOverflow = showString "heap overflow"
440 showsPrec _ ThreadKilled = showString "thread killed"
442 instance Show ArrayException where
443 showsPrec _ (IndexOutOfBounds s)
444 = showString "array index out of range"
445 . (if not (null s) then showString ": " . showString s
447 showsPrec _ (UndefinedElement s)
448 = showString "undefined array element"
449 . (if not (null s) then showString ": " . showString s
452 instance Show Exception where
453 showsPrec _ (IOException err) = shows err
454 showsPrec _ (ArithException err) = shows err
455 showsPrec _ (ArrayException err) = shows err
456 showsPrec _ (ErrorCall err) = showString err
457 showsPrec _ (NoMethodError err) = showString err
458 showsPrec _ (PatternMatchFail err) = showString err
459 showsPrec _ (RecSelError err) = showString err
460 showsPrec _ (RecConError err) = showString err
461 showsPrec _ (RecUpdError err) = showString err
462 showsPrec _ (AssertionFailed err) = showString err
463 showsPrec _ (DynException _err) = showString "unknown exception"
464 showsPrec _ (AsyncException e) = shows e
465 showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
466 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
467 showsPrec _ (NonTermination) = showString "<<loop>>"
468 showsPrec _ (UserError err) = showString err
471 %*********************************************************
473 \subsection{Primitive throw}
475 %*********************************************************
478 throw :: Exception -> a
479 throw exception = raise# exception
481 ioError :: Exception -> IO a
482 ioError err = IO $ \s -> throw err s
484 ioException :: IOException -> IO a
485 ioException err = IO $ \s -> throw (IOException err) s
488 %*********************************************************
490 \subsection{Type @IOError@}
492 %*********************************************************
494 A value @IOError@ encode errors occurred in the @IO@ monad.
495 An @IOError@ records a more specific error type, a descriptive
496 string and maybe the handle that was used when the error was
500 type IOError = Exception
504 (Maybe Handle) -- the handle used by the action flagging the
506 IOErrorType -- what it was.
508 String -- error type specific information.
509 (Maybe FilePath) -- filename the error is related to.
511 instance Eq IOException where
512 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
513 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
516 = AlreadyExists | HardwareFault
517 | IllegalOperation | InappropriateType
518 | Interrupted | InvalidArgument
519 | NoSuchThing | OtherError
520 | PermissionDenied | ProtocolError
521 | ResourceBusy | ResourceExhausted
522 | ResourceVanished | SystemError
523 | TimeExpired | UnsatisfiedConstraints
524 | UnsupportedOperation
526 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
527 | ComError Int -- HRESULT
531 instance Show IOErrorType where
535 AlreadyExists -> "already exists"
536 HardwareFault -> "hardware fault"
537 IllegalOperation -> "illegal operation"
538 InappropriateType -> "inappropriate type"
539 Interrupted -> "interrupted"
540 InvalidArgument -> "invalid argument"
541 NoSuchThing -> "does not exist"
542 OtherError -> "failed"
543 PermissionDenied -> "permission denied"
544 ProtocolError -> "protocol error"
545 ResourceBusy -> "resource busy"
546 ResourceExhausted -> "resource exhausted"
547 ResourceVanished -> "resource vanished"
548 SystemError -> "system error"
549 TimeExpired -> "timeout"
550 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
551 UnsupportedOperation -> "unsupported operation"
553 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
554 ComError _ -> "COM error"
559 userError :: String -> IOError
560 userError str = UserError str
563 Predicates on IOError; little effort made on these so far...
567 isAlreadyExistsError :: IOError -> Bool
568 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
569 isAlreadyExistsError _ = False
571 isAlreadyInUseError :: IOError -> Bool
572 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
573 isAlreadyInUseError _ = False
575 isFullError :: IOError -> Bool
576 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
577 isFullError _ = False
579 isEOFError :: IOError -> Bool
580 isEOFError (IOException (IOError _ EOF _ _ _)) = True
583 isIllegalOperation :: IOError -> Bool
584 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
585 isIllegalOperation _ = False
587 isPermissionError :: IOError -> Bool
588 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
589 isPermissionError _ = False
591 isDoesNotExistError :: IOError -> Bool
592 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
593 isDoesNotExistError _ = False
595 isUserError :: IOError -> Bool
596 isUserError (UserError _) = True
597 isUserError _ = False
604 -- For now we give a fairly uninformative error message which just happens to
605 -- be like the ones that Hugs used to give.
606 instance Show IOException where
607 showsPrec p (IOError _ _ _ s _) = showString s . showChar '\n'
609 instance Show IOException where
610 showsPrec p (IOError hdl iot loc s fn) =
614 _ -> showString "\nAction: " . showString loc) .
618 _ -> showString "\nReason: " . showString s) .
621 Just name -> showString "\nFile: " . showString name)
626 Just h -> showString "\nHandle: " . showsPrec p h
631 The @String@ part of an @IOError@ is platform-dependent. However, to
632 provide a uniform mechanism for distinguishing among errors within
633 these broad categories, each platform-specific standard shall specify
634 the exact strings to be used for particular errors. For errors not
635 explicitly mentioned in the standard, any descriptive string may be
639 constructErrorAndFail :: String -> IO a
640 constructErrorAndFail call_site
641 = constructError call_site >>= \ io_error ->
642 ioError (IOException io_error)
644 constructErrorAndFailWithInfo :: String -> String -> IO a
645 constructErrorAndFailWithInfo call_site fn
646 = constructErrorMsg call_site (Just fn) >>= \ io_error ->
647 ioError (IOException io_error)
651 This doesn't seem to be documented/spelled out anywhere,
654 The implementation of the IO prelude uses various C stubs
655 to do the actual interaction with the OS. The bandwidth
656 \tr{C<->Haskell} is somewhat limited, so the general strategy
657 for flaggging any errors (apart from possibly using the
658 return code of the external call), is to set the @ghc_errtype@
659 to a value that is one of the \tr{#define}s in @includes/error.h@.
660 @ghc_errstr@ holds a character string providing error-specific
661 information. Error constructing functions will then reach out
662 and grab these values when generating
665 constructError :: String -> IO IOException
666 constructError call_site = constructErrorMsg call_site Nothing
668 constructErrorMsg :: String -> Maybe String -> IO IOException
669 constructErrorMsg call_site fn =
670 getErrType__ >>= \ errtype ->
671 getErrStr__ >>= \ str ->
674 case (errtype::Int) of
675 ERR_ALREADYEXISTS -> AlreadyExists
676 ERR_HARDWAREFAULT -> HardwareFault
677 ERR_ILLEGALOPERATION -> IllegalOperation
678 ERR_INAPPROPRIATETYPE -> InappropriateType
679 ERR_INTERRUPTED -> Interrupted
680 ERR_INVALIDARGUMENT -> InvalidArgument
681 ERR_NOSUCHTHING -> NoSuchThing
682 ERR_OTHERERROR -> OtherError
683 ERR_PERMISSIONDENIED -> PermissionDenied
684 ERR_PROTOCOLERROR -> ProtocolError
685 ERR_RESOURCEBUSY -> ResourceBusy
686 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
687 ERR_RESOURCEVANISHED -> ResourceVanished
688 ERR_SYSTEMERROR -> SystemError
689 ERR_TIMEEXPIRED -> TimeExpired
690 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
691 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
698 OtherError -> "(error code: " ++ show errtype ++ ")"
701 return (IOError Nothing iot call_site msg fn)