1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.20 2000/04/07 13:45:48 simonpj Exp $
4 % (c) The AQUA Project, Glasgow University, 1994-1998
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" #-}
14 #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 {-# SOURCE #-} PrelException ( ioError )
25 import PrelMaybe ( Maybe(..) )
26 import PrelAddr ( Addr(..), nullAddr )
27 import PrelPack ( unpackCString )
30 #if !defined(__CONCURRENT_HASKELL__)
31 import PrelArr ( MutableVar, readVar )
36 #define __CONCURRENT_HASKELL__
38 #define unpackCString primUnpackString
41 #ifndef __PARALLEL_HASKELL__
42 #define FILE_OBJECT ForeignObj
44 #define FILE_OBJECT Addr
48 %*********************************************************
50 \subsection{The @IO@ monad}
52 %*********************************************************
54 The IO Monad is just an instance of the ST monad, where the state is
55 the real world. We use the exception mechanism (in PrelException) to
56 implement IO exceptions.
58 NOTE: The IO representation is deeply wired in to various parts of the
59 system. The following list may or may not be exhaustive:
61 Compiler - types of various primitives in PrimOp.lhs
63 RTS - forceIO (StgMiscClosures.hc)
64 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
66 - raiseAsync (Schedule.c)
68 Prelude - PrelIOBase.lhs, and several other places including
71 Libraries - parts of hslibs/lang.
77 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
79 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
82 instance Functor IO where
83 fmap f x = x >>= (return . f)
85 instance Monad IO where
89 m >> k = m >>= \ _ -> k
93 fail s = error s -- not ioError?
95 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
96 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
98 bindIO :: IO a -> (a -> IO b) -> IO b
99 bindIO (IO m) k = IO ( \ s ->
101 (# new_s, a #) -> unIO (k a) new_s
104 returnIO :: a -> IO a
105 returnIO x = IO (\ s -> (# s, x #))
109 %*********************************************************
111 \subsection{Coercions to @ST@}
113 %*********************************************************
117 /* Hugs doesn't distinguish these types so no coercion required) */
119 stToIO :: ST RealWorld a -> IO a
120 stToIO (ST m) = (IO m)
122 ioToST :: IO a -> ST RealWorld a
123 ioToST (IO m) = (ST m)
127 %*********************************************************
129 \subsection{Unsafe @IO@ operations}
131 %*********************************************************
135 {-# NOINLINE unsafePerformIO #-}
136 unsafePerformIO :: IO a -> a
137 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
139 unsafeInterleaveIO :: IO a -> IO a
140 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
144 %*********************************************************
146 \subsection{Type @IOError@}
148 %*********************************************************
150 A value @IOError@ encode errors occurred in the @IO@ monad.
151 An @IOError@ records a more specific error type, a descriptive
152 string and maybe the handle that was used when the error was
158 (Maybe Handle) -- the handle used by the action flagging the
160 IOErrorType -- what it was.
162 String -- error type specific information.
164 instance Eq IOError where
165 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
166 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
169 = AlreadyExists | HardwareFault
170 | IllegalOperation | InappropriateType
171 | Interrupted | InvalidArgument
172 | NoSuchThing | OtherError
173 | PermissionDenied | ProtocolError
174 | ResourceBusy | ResourceExhausted
175 | ResourceVanished | SystemError
176 | TimeExpired | UnsatisfiedConstraints
177 | UnsupportedOperation | UserError
179 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
180 | ComError Int -- HRESULT
184 instance Show IOErrorType where
188 AlreadyExists -> "already exists"
189 HardwareFault -> "hardware fault"
190 IllegalOperation -> "illegal operation"
191 InappropriateType -> "inappropriate type"
192 Interrupted -> "interrupted"
193 InvalidArgument -> "invalid argument"
194 NoSuchThing -> "does not exist"
195 OtherError -> "failed"
196 PermissionDenied -> "permission denied"
197 ProtocolError -> "protocol error"
198 ResourceBusy -> "resource busy"
199 ResourceExhausted -> "resource exhausted"
200 ResourceVanished -> "resource vanished"
201 SystemError -> "system error"
202 TimeExpired -> "timeout"
203 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
204 UserError -> "failed"
205 UnsupportedOperation -> "unsupported operation"
207 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
208 ComError _ -> "COM error"
213 userError :: String -> IOError
214 userError str = IOError Nothing UserError "" str
217 Predicates on IOError; little effort made on these so far...
221 isAlreadyExistsError :: IOError -> Bool
222 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
223 isAlreadyExistsError _ = False
225 isAlreadyInUseError :: IOError -> Bool
226 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
227 isAlreadyInUseError _ = False
229 isFullError :: IOError -> Bool
230 isFullError (IOError _ ResourceExhausted _ _) = True
231 isFullError _ = False
233 isEOFError :: IOError -> Bool
234 isEOFError (IOError _ EOF _ _) = True
237 isIllegalOperation :: IOError -> Bool
238 isIllegalOperation (IOError _ IllegalOperation _ _) = True
239 isIllegalOperation _ = False
241 isPermissionError :: IOError -> Bool
242 isPermissionError (IOError _ PermissionDenied _ _) = True
243 isPermissionError _ = False
245 isDoesNotExistError :: IOError -> Bool
246 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
247 isDoesNotExistError _ = False
249 isUserError :: IOError -> Bool
250 isUserError (IOError _ UserError _ _) = True
251 isUserError _ = False
258 -- For now we give a fairly uninformative error message which just happens to
259 -- be like the ones that Hugs used to give.
260 instance Show IOError where
261 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
263 instance Show IOError where
264 showsPrec p (IOError hdl iot loc s) =
269 _ -> showString "Action: " . showString loc . showChar '\n') .
273 _ -> showString "Reason: " . showString s)
278 Just h -> showString "Handle: " . showsPrec p h
283 The @String@ part of an @IOError@ is platform-dependent. However, to
284 provide a uniform mechanism for distinguishing among errors within
285 these broad categories, each platform-specific standard shall specify
286 the exact strings to be used for particular errors. For errors not
287 explicitly mentioned in the standard, any descriptive string may be
291 constructErrorAndFail :: String -> IO a
292 constructErrorAndFail call_site
293 = constructError call_site >>= \ io_error ->
296 constructErrorAndFailWithInfo :: String -> String -> IO a
297 constructErrorAndFailWithInfo call_site reason
298 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
303 This doesn't seem to be documented/spelled out anywhere,
306 The implementation of the IO prelude uses various C stubs
307 to do the actual interaction with the OS. The bandwidth
308 \tr{C<->Haskell} is somewhat limited, so the general strategy
309 for flaggging any errors (apart from possibly using the
310 return code of the external call), is to set the @ghc_errtype@
311 to a value that is one of the \tr{#define}s in @includes/error.h@.
312 @ghc_errstr@ holds a character string providing error-specific
313 information. Error constructing functions will then reach out
314 and grab these values when generating
317 constructError :: String -> IO IOError
318 constructError call_site = constructErrorMsg call_site Nothing
320 constructErrorMsg :: String -> Maybe String -> IO IOError
321 constructErrorMsg call_site reason =
322 getErrType__ >>= \ errtype ->
323 getErrStr__ >>= \ str ->
326 case (errtype::Int) of
327 ERR_ALREADYEXISTS -> AlreadyExists
328 ERR_HARDWAREFAULT -> HardwareFault
329 ERR_ILLEGALOPERATION -> IllegalOperation
330 ERR_INAPPROPRIATETYPE -> InappropriateType
331 ERR_INTERRUPTED -> Interrupted
332 ERR_INVALIDARGUMENT -> InvalidArgument
333 ERR_NOSUCHTHING -> NoSuchThing
334 ERR_OTHERERROR -> OtherError
335 ERR_PERMISSIONDENIED -> PermissionDenied
336 ERR_PROTOCOLERROR -> ProtocolError
337 ERR_RESOURCEBUSY -> ResourceBusy
338 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
339 ERR_RESOURCEVANISHED -> ResourceVanished
340 ERR_SYSTEMERROR -> SystemError
341 ERR_TIMEEXPIRED -> TimeExpired
342 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
343 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
350 OtherError -> "(error code: " ++ show errtype ++ ")"
356 return (IOError Nothing iot call_site msg)
359 File names are specified using @FilePath@, a OS-dependent
360 string that (hopefully, I guess) maps to an accessible file/object.
363 type FilePath = String
366 %*********************************************************
368 \subsection{Types @Handle@, @Handle__@}
370 %*********************************************************
372 The type for @Handle@ is defined rather than in @IOHandle@
373 module, as the @IOError@ type uses it..all operations over
374 a handles reside in @IOHandle@.
380 Sigh, the MVar ops in ConcBase depend on IO, the IO
381 representation here depend on MVars for handles (when
382 compiling in a concurrent way). Break the cycle by having
383 the definition of MVars go here:
386 data MVar a = MVar (MVar# RealWorld a)
388 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
389 instance Eq (MVar a) where
390 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
393 Double sigh - ForeignObj is needed here too to break a cycle.
395 data ForeignObj = ForeignObj ForeignObj# -- another one
396 instance CCallable ForeignObj
398 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
400 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
402 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
404 instance Eq ForeignObj where
405 p == q = eqForeignObj p q
406 p /= q = not (eqForeignObj p q)
407 #endif /* ndef __HUGS__ */
409 #if defined(__CONCURRENT_HASKELL__)
410 newtype Handle = Handle (MVar Handle__)
412 newtype Handle = Handle (MutableVar RealWorld Handle__)
415 instance Eq Handle where
416 (Handle h1) == (Handle h2) = h1 == h2
419 A Handle is represented by (a reference to) a record
420 containing the state of the I/O port/device. We record
421 the following pieces of info:
423 * type (read,write,closed etc.)
424 * pointer to the external file object.
426 * user-friendly name (usually the
427 FilePath used when IO.openFile was called)
429 Note: when a Handle is garbage collected, we want to flush its buffer
430 and close the OS file handle, so as to free up a (precious) resource.
434 haFO__ :: FILE_OBJECT,
435 haType__ :: Handle__Type,
436 haBufferMode__ :: BufferMode,
437 haFilePath__ :: FilePath
441 Internally, we classify handles as being one
445 = ErrorHandle IOError
454 -- handle types are 'show'ed when printing error msgs, so
455 -- we provide a more user-friendly Show instance for it
456 -- than the derived one.
457 instance Show Handle__Type where
460 ErrorHandle iot -> showString "error " . showsPrec p iot
461 ClosedHandle -> showString "closed"
462 SemiClosedHandle -> showString "semi-closed"
463 ReadHandle -> showString "readable"
464 WriteHandle -> showString "writeable"
465 AppendHandle -> showString "writeable (append)"
466 ReadWriteHandle -> showString "read-writeable"
468 instance Show Handle where
469 showsPrec p (Handle h) =
471 #if defined(__CONCURRENT_HASKELL__)
473 hdl_ = unsafePerformIO (primTakeMVar h)
475 -- (Big) SIGH: unfolded defn of takeMVar to avoid
476 -- an (oh-so) unfortunate module loop with PrelConc.
477 hdl_ = unsafePerformIO (IO $ \ s# ->
478 case h of { MVar h# ->
479 case takeMVar# h# s# of { (# s2# , r #) ->
483 hdl_ = unsafePerformIO (stToIO (readVar h))
487 showHdl (haType__ hdl_)
488 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
489 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
490 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
492 showHdl :: Handle__Type -> ShowS -> ShowS
495 ClosedHandle -> showsPrec p ht . showString "}\n"
496 ErrorHandle _ -> showsPrec p ht . showString "}\n"
499 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
502 NoBuffering -> showString "none"
503 LineBuffering -> showString "line"
504 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
505 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
508 def = unsafePerformIO (getBufSize fo)
510 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
511 mkBuffer__ fo sz_in_bytes = do
514 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
516 chunk <- allocMemory__ sz_in_bytes
518 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
520 setBuf fo chunk sz_in_bytes
524 %*********************************************************
526 \subsection[BufferMode]{Buffering modes}
528 %*********************************************************
530 Three kinds of buffering are supported: line-buffering,
531 block-buffering or no-buffering. These modes have the following
532 effects. For output, items are written out from the internal
533 buffer according to the buffer mode:
536 \item[line-buffering] the entire output buffer is written
537 out whenever a newline is output, the output buffer overflows,
538 a flush is issued, or the handle is closed.
540 \item[block-buffering] the entire output buffer is written out whenever
541 it overflows, a flush is issued, or the handle
544 \item[no-buffering] output is written immediately, and never stored
545 in the output buffer.
548 The output buffer is emptied as soon as it has been written out.
550 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
552 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
553 the next item is obtained from the buffer;
554 otherwise, when the input buffer is empty,
555 characters up to and including the next newline
556 character are read into the buffer. No characters
557 are available until the newline character is
559 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
560 the next block of data is read into this buffer.
561 \item[no-buffering] the next input item is read and returned.
564 For most implementations, physical files will normally be block-buffered
565 and terminals will normally be line-buffered. (the IO interface provides
566 operations for changing the default buffering of a handle tho.)
570 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
571 deriving (Eq, Ord, Show)
572 {- Read instance defined in IO. -}
576 Foreign import declarations to helper routines:
579 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
580 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
581 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
583 foreign import "libHS_cbits" "allocMemory__" unsafe
584 allocMemory__ :: Int -> IO Addr
585 foreign import "libHS_cbits" "getBufSize" unsafe
586 getBufSize :: FILE_OBJECT -> IO Int
587 foreign import "libHS_cbits" "setBuf" unsafe
588 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()