1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.19 2000/03/28 08:51:09 simonmar 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
90 return x = IO $ \ s -> (# s, x #)
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
107 %*********************************************************
109 \subsection{Coercions to @ST@}
111 %*********************************************************
115 /* Hugs doesn't distinguish these types so no coercion required) */
117 stToIO :: ST RealWorld a -> IO a
118 stToIO (ST m) = (IO m)
120 ioToST :: IO a -> ST RealWorld a
121 ioToST (IO m) = (ST m)
125 %*********************************************************
127 \subsection{Unsafe @IO@ operations}
129 %*********************************************************
133 {-# NOINLINE unsafePerformIO #-}
134 unsafePerformIO :: IO a -> a
135 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
137 unsafeInterleaveIO :: IO a -> IO a
138 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
142 %*********************************************************
144 \subsection{Type @IOError@}
146 %*********************************************************
148 A value @IOError@ encode errors occurred in the @IO@ monad.
149 An @IOError@ records a more specific error type, a descriptive
150 string and maybe the handle that was used when the error was
156 (Maybe Handle) -- the handle used by the action flagging the
158 IOErrorType -- what it was.
160 String -- error type specific information.
162 instance Eq IOError where
163 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
164 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
167 = AlreadyExists | HardwareFault
168 | IllegalOperation | InappropriateType
169 | Interrupted | InvalidArgument
170 | NoSuchThing | OtherError
171 | PermissionDenied | ProtocolError
172 | ResourceBusy | ResourceExhausted
173 | ResourceVanished | SystemError
174 | TimeExpired | UnsatisfiedConstraints
175 | UnsupportedOperation | UserError
177 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
178 | ComError Int -- HRESULT
182 instance Show IOErrorType where
186 AlreadyExists -> "already exists"
187 HardwareFault -> "hardware fault"
188 IllegalOperation -> "illegal operation"
189 InappropriateType -> "inappropriate type"
190 Interrupted -> "interrupted"
191 InvalidArgument -> "invalid argument"
192 NoSuchThing -> "does not exist"
193 OtherError -> "failed"
194 PermissionDenied -> "permission denied"
195 ProtocolError -> "protocol error"
196 ResourceBusy -> "resource busy"
197 ResourceExhausted -> "resource exhausted"
198 ResourceVanished -> "resource vanished"
199 SystemError -> "system error"
200 TimeExpired -> "timeout"
201 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
202 UserError -> "failed"
203 UnsupportedOperation -> "unsupported operation"
205 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
206 ComError _ -> "COM error"
211 userError :: String -> IOError
212 userError str = IOError Nothing UserError "" str
215 Predicates on IOError; little effort made on these so far...
219 isAlreadyExistsError :: IOError -> Bool
220 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
221 isAlreadyExistsError _ = False
223 isAlreadyInUseError :: IOError -> Bool
224 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
225 isAlreadyInUseError _ = False
227 isFullError :: IOError -> Bool
228 isFullError (IOError _ ResourceExhausted _ _) = True
229 isFullError _ = False
231 isEOFError :: IOError -> Bool
232 isEOFError (IOError _ EOF _ _) = True
235 isIllegalOperation :: IOError -> Bool
236 isIllegalOperation (IOError _ IllegalOperation _ _) = True
237 isIllegalOperation _ = False
239 isPermissionError :: IOError -> Bool
240 isPermissionError (IOError _ PermissionDenied _ _) = True
241 isPermissionError _ = False
243 isDoesNotExistError :: IOError -> Bool
244 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
245 isDoesNotExistError _ = False
247 isUserError :: IOError -> Bool
248 isUserError (IOError _ UserError _ _) = True
249 isUserError _ = False
256 -- For now we give a fairly uninformative error message which just happens to
257 -- be like the ones that Hugs used to give.
258 instance Show IOError where
259 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
261 instance Show IOError where
262 showsPrec p (IOError hdl iot loc s) =
267 _ -> showString "Action: " . showString loc . showChar '\n') .
271 _ -> showString "Reason: " . showString s)
276 Just h -> showString "Handle: " . showsPrec p h
281 The @String@ part of an @IOError@ is platform-dependent. However, to
282 provide a uniform mechanism for distinguishing among errors within
283 these broad categories, each platform-specific standard shall specify
284 the exact strings to be used for particular errors. For errors not
285 explicitly mentioned in the standard, any descriptive string may be
289 constructErrorAndFail :: String -> IO a
290 constructErrorAndFail call_site
291 = constructError call_site >>= \ io_error ->
294 constructErrorAndFailWithInfo :: String -> String -> IO a
295 constructErrorAndFailWithInfo call_site reason
296 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
301 This doesn't seem to be documented/spelled out anywhere,
304 The implementation of the IO prelude uses various C stubs
305 to do the actual interaction with the OS. The bandwidth
306 \tr{C<->Haskell} is somewhat limited, so the general strategy
307 for flaggging any errors (apart from possibly using the
308 return code of the external call), is to set the @ghc_errtype@
309 to a value that is one of the \tr{#define}s in @includes/error.h@.
310 @ghc_errstr@ holds a character string providing error-specific
311 information. Error constructing functions will then reach out
312 and grab these values when generating
315 constructError :: String -> IO IOError
316 constructError call_site = constructErrorMsg call_site Nothing
318 constructErrorMsg :: String -> Maybe String -> IO IOError
319 constructErrorMsg call_site reason =
320 getErrType__ >>= \ errtype ->
321 getErrStr__ >>= \ str ->
324 case (errtype::Int) of
325 ERR_ALREADYEXISTS -> AlreadyExists
326 ERR_HARDWAREFAULT -> HardwareFault
327 ERR_ILLEGALOPERATION -> IllegalOperation
328 ERR_INAPPROPRIATETYPE -> InappropriateType
329 ERR_INTERRUPTED -> Interrupted
330 ERR_INVALIDARGUMENT -> InvalidArgument
331 ERR_NOSUCHTHING -> NoSuchThing
332 ERR_OTHERERROR -> OtherError
333 ERR_PERMISSIONDENIED -> PermissionDenied
334 ERR_PROTOCOLERROR -> ProtocolError
335 ERR_RESOURCEBUSY -> ResourceBusy
336 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
337 ERR_RESOURCEVANISHED -> ResourceVanished
338 ERR_SYSTEMERROR -> SystemError
339 ERR_TIMEEXPIRED -> TimeExpired
340 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
341 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
348 OtherError -> "(error code: " ++ show errtype ++ ")"
354 return (IOError Nothing iot call_site msg)
357 File names are specified using @FilePath@, a OS-dependent
358 string that (hopefully, I guess) maps to an accessible file/object.
361 type FilePath = String
364 %*********************************************************
366 \subsection{Types @Handle@, @Handle__@}
368 %*********************************************************
370 The type for @Handle@ is defined rather than in @IOHandle@
371 module, as the @IOError@ type uses it..all operations over
372 a handles reside in @IOHandle@.
378 Sigh, the MVar ops in ConcBase depend on IO, the IO
379 representation here depend on MVars for handles (when
380 compiling in a concurrent way). Break the cycle by having
381 the definition of MVars go here:
384 data MVar a = MVar (MVar# RealWorld a)
386 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
387 instance Eq (MVar a) where
388 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
391 Double sigh - ForeignObj is needed here too to break a cycle.
393 data ForeignObj = ForeignObj ForeignObj# -- another one
394 instance CCallable ForeignObj
396 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
398 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
400 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
402 instance Eq ForeignObj where
403 p == q = eqForeignObj p q
404 p /= q = not (eqForeignObj p q)
405 #endif /* ndef __HUGS__ */
407 #if defined(__CONCURRENT_HASKELL__)
408 newtype Handle = Handle (MVar Handle__)
410 newtype Handle = Handle (MutableVar RealWorld Handle__)
413 instance Eq Handle where
414 (Handle h1) == (Handle h2) = h1 == h2
417 A Handle is represented by (a reference to) a record
418 containing the state of the I/O port/device. We record
419 the following pieces of info:
421 * type (read,write,closed etc.)
422 * pointer to the external file object.
424 * user-friendly name (usually the
425 FilePath used when IO.openFile was called)
427 Note: when a Handle is garbage collected, we want to flush its buffer
428 and close the OS file handle, so as to free up a (precious) resource.
432 haFO__ :: FILE_OBJECT,
433 haType__ :: Handle__Type,
434 haBufferMode__ :: BufferMode,
435 haFilePath__ :: FilePath
439 Internally, we classify handles as being one
443 = ErrorHandle IOError
452 -- handle types are 'show'ed when printing error msgs, so
453 -- we provide a more user-friendly Show instance for it
454 -- than the derived one.
455 instance Show Handle__Type where
458 ErrorHandle iot -> showString "error " . showsPrec p iot
459 ClosedHandle -> showString "closed"
460 SemiClosedHandle -> showString "semi-closed"
461 ReadHandle -> showString "readable"
462 WriteHandle -> showString "writeable"
463 AppendHandle -> showString "writeable (append)"
464 ReadWriteHandle -> showString "read-writeable"
466 instance Show Handle where
467 showsPrec p (Handle h) =
469 #if defined(__CONCURRENT_HASKELL__)
471 hdl_ = unsafePerformIO (primTakeMVar h)
473 -- (Big) SIGH: unfolded defn of takeMVar to avoid
474 -- an (oh-so) unfortunate module loop with PrelConc.
475 hdl_ = unsafePerformIO (IO $ \ s# ->
476 case h of { MVar h# ->
477 case takeMVar# h# s# of { (# s2# , r #) ->
481 hdl_ = unsafePerformIO (stToIO (readVar h))
485 showHdl (haType__ hdl_)
486 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
487 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
488 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
490 showHdl :: Handle__Type -> ShowS -> ShowS
493 ClosedHandle -> showsPrec p ht . showString "}\n"
494 ErrorHandle _ -> showsPrec p ht . showString "}\n"
497 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
500 NoBuffering -> showString "none"
501 LineBuffering -> showString "line"
502 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
503 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
506 def = unsafePerformIO (getBufSize fo)
508 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
509 mkBuffer__ fo sz_in_bytes = do
512 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
514 chunk <- allocMemory__ sz_in_bytes
516 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
518 setBuf fo chunk sz_in_bytes
522 %*********************************************************
524 \subsection[BufferMode]{Buffering modes}
526 %*********************************************************
528 Three kinds of buffering are supported: line-buffering,
529 block-buffering or no-buffering. These modes have the following
530 effects. For output, items are written out from the internal
531 buffer according to the buffer mode:
534 \item[line-buffering] the entire output buffer is written
535 out whenever a newline is output, the output buffer overflows,
536 a flush is issued, or the handle is closed.
538 \item[block-buffering] the entire output buffer is written out whenever
539 it overflows, a flush is issued, or the handle
542 \item[no-buffering] output is written immediately, and never stored
543 in the output buffer.
546 The output buffer is emptied as soon as it has been written out.
548 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
550 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
551 the next item is obtained from the buffer;
552 otherwise, when the input buffer is empty,
553 characters up to and including the next newline
554 character are read into the buffer. No characters
555 are available until the newline character is
557 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
558 the next block of data is read into this buffer.
559 \item[no-buffering] the next input item is read and returned.
562 For most implementations, physical files will normally be block-buffered
563 and terminals will normally be line-buffered. (the IO interface provides
564 operations for changing the default buffering of a handle tho.)
568 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
569 deriving (Eq, Ord, Show)
570 {- Read instance defined in IO. -}
574 Foreign import declarations to helper routines:
577 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
578 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
579 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
581 foreign import "libHS_cbits" "allocMemory__" unsafe
582 allocMemory__ :: Int -> IO Addr
583 foreign import "libHS_cbits" "getBufSize" unsafe
584 getBufSize :: FILE_OBJECT -> IO Int
585 foreign import "libHS_cbits" "setBuf" unsafe
586 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()