2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelIOBase]{Module @PrelIOBase@}
7 Definitions for the @IO@ monad and its friends. Everything is exported
8 concretely; the @IO@ module itself exports abstractly.
11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
14 module PrelIOBase where
16 import {-# SOURCE #-} PrelErr ( error )
18 import PrelST ( ST(..), STret(..), StateAndPtr#(..) )
19 import PrelMaybe ( Maybe(..) )
20 import PrelAddr ( Addr(..), nullAddr )
21 import PrelPack ( unpackCString )
22 import PrelArr ( MutableVar, readVar )
26 %*********************************************************
28 \subsection{The @IO@ monad}
30 %*********************************************************
32 IO is no longer built on top of PrimIO (which used to be a specialised
33 version of the ST monad), instead it is now has its own type. This is
34 purely for efficiency purposes, since we get to remove several levels
35 of lifting in the type of the monad.
38 newtype IO a = IO (State# RealWorld -> IOResult a)
43 data IOResult a = IOok (State# RealWorld) a
44 | IOfail (State# RealWorld) IOError
46 instance Functor IO where
47 map f x = x >>= (return . f)
49 instance Monad IO where
53 m >> k = m >>= \ _ -> k
54 return x = IO $ \ s -> IOok s x
59 IOfail new_s err -> IOfail new_s err
60 IOok new_s a -> unIO (k a) new_s
62 fixIO :: (a -> IO a) -> IO a
63 -- not required but worth having around
73 fail :: IOError -> IO a
74 fail err = IO $ \ s -> IOfail s err
76 userError :: String -> IOError
77 userError str = IOError Nothing (UserError Nothing) "" str
79 catch :: IO a -> (IOError -> IO a) -> IO a
80 catch (IO m) k = IO $ \ s ->
82 IOok new_s a -> IOok new_s a
83 IOfail new_s e -> unIO (k e) new_s
85 instance Show (IO a) where
86 showsPrec p f = showString "<<IO action>>"
87 showList = showList__ (showsPrec 0)
90 %*********************************************************
92 \subsection{Coercions to @ST@}
94 %*********************************************************
97 stToIO :: ST RealWorld a -> IO a
98 stToIO (ST m) = IO $ \ s -> case (m s) of STret new_s r -> IOok new_s r
100 ioToST :: IO a -> ST RealWorld a
101 ioToST (IO io) = ST $ \ s ->
103 IOok new_s a -> STret new_s a
104 IOfail new_s e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
107 %*********************************************************
109 \subsection{Type @IOError@}
111 %*********************************************************
113 A value @IOError@ encode errors occurred in the @IO@ monad.
114 An @IOError@ records a more specific error type, a descriptive
115 string and maybe the handle that was used when the error was
121 (Maybe Handle) -- the handle used by the action flagging the
123 IOErrorType -- what it was.
125 String -- error type specific information.
129 = AlreadyExists | HardwareFault
130 | IllegalOperation | InappropriateType
131 | Interrupted | InvalidArgument
132 | NoSuchThing | OtherError
133 | PermissionDenied | ProtocolError
134 | ResourceBusy | ResourceExhausted
135 | ResourceVanished | SystemError
136 | TimeExpired | UnsatisfiedConstraints
137 | UnsupportedOperation | UserError (Maybe Addr)
141 instance Show IOErrorType where
145 AlreadyExists -> "already exists"
146 HardwareFault -> "hardware fault"
147 IllegalOperation -> "illegal operation"
148 InappropriateType -> "inappropriate type"
149 Interrupted -> "interrupted"
150 InvalidArgument -> "invalid argument"
151 NoSuchThing -> "does not exist"
152 OtherError -> "failed"
153 PermissionDenied -> "permission denied"
154 ProtocolError -> "protocol error"
155 ResourceBusy -> "resource busy"
156 ResourceExhausted -> "resource exhausted"
157 ResourceVanished -> "resource vanished"
158 SystemError -> "system error"
159 TimeExpired -> "timeout"
160 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
161 UserError _ -> "failed"
166 Predicates on IOError; little effort made on these so far...
170 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
171 isAlreadyExistsError _ = False
173 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
174 isAlreadyInUseError _ = False
176 isFullError (IOError _ ResourceExhausted _ _) = True
177 isFullError _ = False
179 isEOFError (IOError _ EOF _ _) = True
182 isIllegalOperation (IOError _ IllegalOperation _ _) = True
183 isIllegalOperation _ = False
185 isPermissionError (IOError _ PermissionDenied _ _) = True
186 isPermissionError _ = False
188 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
189 isDoesNotExistError _ = False
191 isUserError (IOError _ (UserError _) _ _) = True
192 isUserError _ = False
198 instance Show IOError where
199 showsPrec p (IOError hdl iot loc s) =
204 _ -> showString "Action: " . showString loc . showChar '\n') .
208 _ -> showString "Reason: " . showString s)
213 Just h -> showString "Handle: " . showsPrec p h
218 The @String@ part of an @IOError@ is platform-dependent. However, to
219 provide a uniform mechanism for distinguishing among errors within
220 these broad categories, each platform-specific standard shall specify
221 the exact strings to be used for particular errors. For errors not
222 explicitly mentioned in the standard, any descriptive string may be
226 constructErrorAndFail :: String -> IO a
227 constructErrorAndFail call_site
228 = constructError call_site >>= \ io_error ->
231 constructErrorAndFailWithInfo :: String -> String -> IO a
232 constructErrorAndFailWithInfo call_site reason
233 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
238 This doesn't seem to be documented/spelled out anywhere,
241 The implementation of the IO prelude uses various C stubs
242 to do the actual interaction with the OS. The bandwidth
243 \tr{C<->Haskell} is somewhat limited, so the general strategy
244 for flaggging any errors (apart from possibly using the
245 return code of the external call), is to set the @ghc_errtype@
246 to a value that is one of the \tr{#define}s in @includes/error.h@.
247 @ghc_errstr@ holds a character string providing error-specific
248 information. Error constructing functions will then reach out
249 and grab these values when generating
252 constructError :: String -> IO IOError
253 constructError call_site = constructErrorMsg call_site Nothing
255 constructErrorMsg :: String -> Maybe String -> IO IOError
256 constructErrorMsg call_site reason =
257 _ccall_ getErrType__ >>= \ (I# errtype#) ->
258 _ccall_ getErrStr__ >>= \ str ->
262 ERR_ALREADYEXISTS# -> AlreadyExists
263 ERR_HARDWAREFAULT# -> HardwareFault
264 ERR_ILLEGALOPERATION# -> IllegalOperation
265 ERR_INAPPROPRIATETYPE# -> InappropriateType
266 ERR_INTERRUPTED# -> Interrupted
267 ERR_INVALIDARGUMENT# -> InvalidArgument
268 ERR_NOSUCHTHING# -> NoSuchThing
269 ERR_OTHERERROR# -> OtherError
270 ERR_PERMISSIONDENIED# -> PermissionDenied
271 ERR_PROTOCOLERROR# -> ProtocolError
272 ERR_RESOURCEBUSY# -> ResourceBusy
273 ERR_RESOURCEEXHAUSTED# -> ResourceExhausted
274 ERR_RESOURCEVANISHED# -> ResourceVanished
275 ERR_SYSTEMERROR# -> SystemError
276 ERR_TIMEEXPIRED# -> TimeExpired
277 ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
278 ERR_UNSUPPORTEDOPERATION# -> UnsupportedOperation
285 OtherError -> "(error code: " ++ show (I# errtype#) ++ ")"
291 return (IOError Nothing iot call_site msg)
294 %*********************************************************
296 \subsection{Types @Handle@, @Handle__@}
298 %*********************************************************
300 The type for @Handle@ is defined rather than in @IOHandle@
301 module, as the @IOError@ type uses it..all operations over
302 a handles reside in @IOHandle@.
307 Sigh, the MVar ops in ConcBase depend on IO, the IO
308 representation here depend on MVars for handles (when
309 compiling in a concurrent way). Break the cycle by having
310 the definition of MVars go here:
313 data MVar a = MVar (SynchVar# RealWorld a)
316 Double sigh - ForeignObj is needed here too to break a cycle.
318 data ForeignObj = ForeignObj ForeignObj# -- another one
319 instance CCallable ForeignObj
320 instance CCallable ForeignObj#
322 makeForeignObj :: Addr -> Addr -> IO ForeignObj
323 makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
324 case makeForeignObj# obj finaliser s# of
325 StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
327 data StateAndForeignObj# s = StateAndForeignObj# (State# s) ForeignObj#
330 #if defined(__CONCURRENT_HASKELL__)
331 newtype Handle = Handle (MVar Handle__)
333 newtype Handle = Handle (MutableVar RealWorld Handle__)
336 #ifndef __PARALLEL_HASKELL__
337 #define FILE_OBJECT ForeignObj
339 #define FILE_OBJECT Addr
343 A Handle is represented by (a reference to) a record
344 containing the state of the I/O port/device. We record
345 the following pieces of info:
347 * type (read,write,closed etc.)
348 * pointer to the external file object.
350 * user-friendly name (usually the
351 FilePath used when IO.openFile was called)
353 Note: when a Handle is garbage collected, we want to flush its buffer
354 and close the OS file handle, so as to free up a (precious) resource.
356 This means that the finaliser for the handle needs to have access to
357 the buffer and the OS file handle. The current implementation of foreign
358 objects requires that the finaliser is implemented in C, so to
359 arrange for this to happen, openFile() returns a pointer to a structure
360 big enough to hold the OS file handle and a pointer to the buffer.
361 This pointer is then wrapped up inside a ForeignObj, and finalised
367 haFO__ :: FILE_OBJECT,
368 haType__ :: Handle__Type,
369 haBufferMode__ :: BufferMode,
370 haFilePath__ :: String
374 Internally, we classify handles as being one
379 = ErrorHandle IOError
388 -- handle types are 'show'ed when printing error msgs, so
389 -- we provide a more user-friendly Show instance for it
390 -- than the derived one.
391 instance Show Handle__Type where
394 ErrorHandle iot -> showString "error " . showsPrec p iot
395 ClosedHandle -> showString "closed"
396 SemiClosedHandle -> showString "semi-closed"
397 ReadHandle -> showString "readable"
398 WriteHandle -> showString "writeable"
399 AppendHandle -> showString "writeable (append)"
400 ReadWriteHandle -> showString "read-writeable"
402 instance Show Handle where
403 showsPrec p (Handle h) =
405 #if defined(__CONCURRENT_HASKELL__)
406 -- (Big) SIGH: unfolded defn of takeMVar to avoid
407 -- an (oh-so) unfortunate module loop with PrelConc.
408 hdl_ = unsafePerformIO (IO $ \ s# ->
409 case h of { MVar h# ->
410 case takeMVar# h# s# of { StateAndPtr# s2# r ->
413 hdl_ = unsafePerformIO (stToIO (readVar h))
417 showHdl (haType__ hdl_)
418 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
419 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
420 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
422 showHdl :: Handle__Type -> ShowS -> ShowS
425 ClosedHandle -> showsPrec p ht . showString "}\n"
426 ErrorHandle _ -> showsPrec p ht . showString "}\n"
429 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
432 NoBuffering -> showString "none"
433 LineBuffering -> showString "line"
434 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
435 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
438 def = unsafePerformIO (_ccall_ getBufSize fo)
442 nullFile__ is only used for closed handles, plugging it in as
443 a null file object reference.
445 nullFile__ :: FILE_OBJECT
447 #ifndef __PARALLEL_HASKELL__
448 unsafePerformIO (makeForeignObj nullAddr nullAddr{-i.e., don't finalise-})
454 mkClosedHandle__ :: Handle__
462 mkErrorHandle__ :: IOError -> Handle__
463 mkErrorHandle__ ioe =
470 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
471 mkBuffer__ fo sz_in_bytes = do
474 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
476 chunk <- _ccall_ allocMemory__ sz_in_bytes
478 then fail (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
480 _ccall_ setBuf fo chunk sz_in_bytes
484 %*********************************************************
486 \subsection[BufferMode]{Buffering modes}
488 %*********************************************************
490 Three kinds of buffering are supported: line-buffering,
491 block-buffering or no-buffering. These modes have the following
492 effects. For output, items are written out from the internal
493 buffer according to the buffer mode:
496 \item[line-buffering] the entire output buffer is written
497 out whenever a newline is output, the output buffer overflows,
498 a flush is issued, or the handle is closed.
500 \item[block-buffering] the entire output buffer is written out whenever
501 it overflows, a flush is issued, or the handle
504 \item[no-buffering] output is written immediately, and never stored
505 in the output buffer.
508 The output buffer is emptied as soon as it has been written out.
510 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
512 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
513 the next item is obtained from the buffer;
514 otherwise, when the input buffer is empty,
515 characters up to and including the next newline
516 character are read into the buffer. No characters
517 are available until the newline character is
519 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
520 the next block of data is read into this buffer.
521 \item[no-buffering] the next input item is read and returned.
524 For most implementations, physical files will normally be block-buffered
525 and terminals will normally be line-buffered. (the IO interface provides
526 operations for changing the default buffering of a handle tho.)
530 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
531 deriving (Eq, Ord, Show)
532 {- Read instance defined in IO. -}
536 %*********************************************************
538 \subsection{Unsafe @IO@ operations}
540 %*********************************************************
543 {-# NOINLINE unsafePerformIO #-}
544 unsafePerformIO :: IO a -> a
545 unsafePerformIO (IO m)
546 = case m realWorld# of
548 IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n")
550 {-# NOINLINE unsafeInterleaveIO #-}
551 unsafeInterleaveIO :: IO a -> IO a
552 unsafeInterleaveIO (IO m) = IO ( \ s ->