1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.7 1999/01/14 18:12:58 sof 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/error.h"
16 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
17 module PrelIOBase where
19 import {-# SOURCE #-} PrelErr ( error )
23 import {-# SOURCE #-} PrelException ( ioError )
24 import PrelST ( ST(..), STret(..) )
25 import PrelMaybe ( Maybe(..) )
26 import PrelAddr ( Addr(..), nullAddr )
27 import PrelPack ( unpackCString )
29 #if !defined(__CONCURRENT_HASKELL__)
30 import PrelArr ( MutableVar, readVar )
35 #define cat2(x,y) x/**/y
36 #define CCALL(fun) cat2(prim_,fun)
37 #define __CONCURRENT_HASKELL__
39 #define unpackCString primUnpackString
41 #define CCALL(fun) _ccall_ fun
42 #define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
45 #ifndef __PARALLEL_HASKELL__
46 #define FILE_OBJECT ForeignObj
48 #define FILE_OBJECT Addr
52 %*********************************************************
54 \subsection{The @IO@ monad}
56 %*********************************************************
58 The IO Monad is just an instance of the ST monad, where the state is
59 the real world. We use the exception mechanism (in PrelException) to
60 implement IO exceptions.
64 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
66 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
69 instance Functor IO where
70 fmap f x = x >>= (return . f)
72 instance Monad IO where
76 m >> k = m >>= \ _ -> k
77 return x = IO $ \ s -> (# s, x #)
80 fail s = error s -- not ioError?
82 -- not required but worth having around
83 fixIO :: (a -> IO a) -> IO a
84 fixIO m = stToIO (fixST (ioToST . m))
86 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
87 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
89 bindIO :: IO a -> (a -> IO b) -> IO b
90 bindIO (IO m) k = IO ( \ s ->
92 (# new_s, a #) -> unIO (k a) new_s
98 %*********************************************************
100 \subsection{Coercions to @ST@}
102 %*********************************************************
106 /* Hugs doesn't distinguish these types so no coercion required) */
108 stToIO :: ST RealWorld a -> IO a
109 stToIO (ST m) = (IO m)
111 ioToST :: IO a -> ST RealWorld a
112 ioToST (IO m) = (ST m)
116 %*********************************************************
118 \subsection{Utility functions}
120 %*********************************************************
122 I'm not sure why this little function is here...
125 --fputs :: Addr{-FILE*-} -> String -> IO Bool
127 userError :: String -> IOError
128 userError str = IOError Nothing (UserError Nothing) "" str
131 fputs stream (c : cs)
132 = CCALL(filePutc) stream c >>
137 %*********************************************************
139 \subsection{Unsafe @IO@ operations}
141 %*********************************************************
145 {-# NOINLINE unsafePerformIO #-}
146 unsafePerformIO :: IO a -> a
147 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
149 unsafeInterleaveIO :: IO a -> IO a
150 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
154 %*********************************************************
156 \subsection{Type @IOError@}
158 %*********************************************************
160 A value @IOError@ encode errors occurred in the @IO@ monad.
161 An @IOError@ records a more specific error type, a descriptive
162 string and maybe the handle that was used when the error was
168 (Maybe Handle) -- the handle used by the action flagging the
170 IOErrorType -- what it was.
172 String -- error type specific information.
176 = AlreadyExists | HardwareFault
177 | IllegalOperation | InappropriateType
178 | Interrupted | InvalidArgument
179 | NoSuchThing | OtherError
180 | PermissionDenied | ProtocolError
181 | ResourceBusy | ResourceExhausted
182 | ResourceVanished | SystemError
183 | TimeExpired | UnsatisfiedConstraints
184 | UnsupportedOperation | UserError (Maybe Addr)
188 instance Show IOErrorType where
192 AlreadyExists -> "already exists"
193 HardwareFault -> "hardware fault"
194 IllegalOperation -> "illegal operation"
195 InappropriateType -> "inappropriate type"
196 Interrupted -> "interrupted"
197 InvalidArgument -> "invalid argument"
198 NoSuchThing -> "does not exist"
199 OtherError -> "failed"
200 PermissionDenied -> "permission denied"
201 ProtocolError -> "protocol error"
202 ResourceBusy -> "resource busy"
203 ResourceExhausted -> "resource exhausted"
204 ResourceVanished -> "resource vanished"
205 SystemError -> "system error"
206 TimeExpired -> "timeout"
207 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
208 UserError _ -> "failed"
209 UnsupportedOperation -> "unsupported operation"
214 Predicates on IOError; little effort made on these so far...
218 isAlreadyExistsError :: IOError -> Bool
219 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
220 isAlreadyExistsError _ = False
222 isAlreadyInUseError :: IOError -> Bool
223 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
224 isAlreadyInUseError _ = False
226 isFullError :: IOError -> Bool
227 isFullError (IOError _ ResourceExhausted _ _) = True
228 isFullError _ = False
230 isEOFError :: IOError -> Bool
231 isEOFError (IOError _ EOF _ _) = True
234 isIllegalOperation :: IOError -> Bool
235 isIllegalOperation (IOError _ IllegalOperation _ _) = True
236 isIllegalOperation _ = False
238 isPermissionError :: IOError -> Bool
239 isPermissionError (IOError _ PermissionDenied _ _) = True
240 isPermissionError _ = False
242 isDoesNotExistError :: IOError -> Bool
243 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
244 isDoesNotExistError _ = False
246 isUserError :: IOError -> Bool
247 isUserError (IOError _ (UserError _) _ _) = True
248 isUserError _ = False
255 -- For now we give a fairly uninformative error message which just happens to
256 -- be like the ones that Hugs used to give.
257 instance Show IOError where
258 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
260 instance Show IOError where
261 showsPrec p (IOError hdl iot loc s) =
266 _ -> showString "Action: " . showString loc . showChar '\n') .
270 _ -> showString "Reason: " . showString s)
275 Just h -> showString "Handle: " . showsPrec p h
280 The @String@ part of an @IOError@ is platform-dependent. However, to
281 provide a uniform mechanism for distinguishing among errors within
282 these broad categories, each platform-specific standard shall specify
283 the exact strings to be used for particular errors. For errors not
284 explicitly mentioned in the standard, any descriptive string may be
288 constructErrorAndFail :: String -> IO a
289 constructErrorAndFail call_site
290 = constructError call_site >>= \ io_error ->
293 constructErrorAndFailWithInfo :: String -> String -> IO a
294 constructErrorAndFailWithInfo call_site reason
295 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
300 This doesn't seem to be documented/spelled out anywhere,
303 The implementation of the IO prelude uses various C stubs
304 to do the actual interaction with the OS. The bandwidth
305 \tr{C<->Haskell} is somewhat limited, so the general strategy
306 for flaggging any errors (apart from possibly using the
307 return code of the external call), is to set the @ghc_errtype@
308 to a value that is one of the \tr{#define}s in @includes/error.h@.
309 @ghc_errstr@ holds a character string providing error-specific
310 information. Error constructing functions will then reach out
311 and grab these values when generating
314 constructError :: String -> IO IOError
315 constructError call_site = constructErrorMsg call_site Nothing
317 constructErrorMsg :: String -> Maybe String -> IO IOError
318 constructErrorMsg call_site reason =
319 CCALL(getErrType__) >>= \ errtype ->
320 CCALL(getErrStr__) >>= \ str ->
323 case (errtype::Int) of
324 ERR_ALREADYEXISTS -> AlreadyExists
325 ERR_HARDWAREFAULT -> HardwareFault
326 ERR_ILLEGALOPERATION -> IllegalOperation
327 ERR_INAPPROPRIATETYPE -> InappropriateType
328 ERR_INTERRUPTED -> Interrupted
329 ERR_INVALIDARGUMENT -> InvalidArgument
330 ERR_NOSUCHTHING -> NoSuchThing
331 ERR_OTHERERROR -> OtherError
332 ERR_PERMISSIONDENIED -> PermissionDenied
333 ERR_PROTOCOLERROR -> ProtocolError
334 ERR_RESOURCEBUSY -> ResourceBusy
335 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
336 ERR_RESOURCEVANISHED -> ResourceVanished
337 ERR_SYSTEMERROR -> SystemError
338 ERR_TIMEEXPIRED -> TimeExpired
339 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
340 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
347 OtherError -> "(error code: " ++ show errtype ++ ")"
353 return (IOError Nothing iot call_site msg)
356 File names are specified using @FilePath@, a OS-dependent
357 string that (hopefully, I guess) maps to an accessible file/object.
360 type FilePath = String
363 %*********************************************************
365 \subsection{Types @Handle@, @Handle__@}
367 %*********************************************************
369 The type for @Handle@ is defined rather than in @IOHandle@
370 module, as the @IOError@ type uses it..all operations over
371 a handles reside in @IOHandle@.
377 Sigh, the MVar ops in ConcBase depend on IO, the IO
378 representation here depend on MVars for handles (when
379 compiling in a concurrent way). Break the cycle by having
380 the definition of MVars go here:
383 data MVar a = MVar (MVar# RealWorld a)
386 Double sigh - ForeignObj is needed here too to break a cycle.
388 data ForeignObj = ForeignObj ForeignObj# -- another one
389 instance CCallable ForeignObj
390 instance CCallable ForeignObj#
391 #endif /* ndef __HUGS__ */
393 #if defined(__CONCURRENT_HASKELL__)
394 newtype Handle = Handle (MVar Handle__)
396 newtype Handle = Handle (MutableVar RealWorld Handle__)
400 A Handle is represented by (a reference to) a record
401 containing the state of the I/O port/device. We record
402 the following pieces of info:
404 * type (read,write,closed etc.)
405 * pointer to the external file object.
407 * user-friendly name (usually the
408 FilePath used when IO.openFile was called)
410 Note: when a Handle is garbage collected, we want to flush its buffer
411 and close the OS file handle, so as to free up a (precious) resource.
415 haFO__ :: FILE_OBJECT,
416 haType__ :: Handle__Type,
417 haBufferMode__ :: BufferMode,
418 haFilePath__ :: FilePath
422 Internally, we classify handles as being one
426 = ErrorHandle IOError
435 -- handle types are 'show'ed when printing error msgs, so
436 -- we provide a more user-friendly Show instance for it
437 -- than the derived one.
438 instance Show Handle__Type where
441 ErrorHandle iot -> showString "error " . showsPrec p iot
442 ClosedHandle -> showString "closed"
443 SemiClosedHandle -> showString "semi-closed"
444 ReadHandle -> showString "readable"
445 WriteHandle -> showString "writeable"
446 AppendHandle -> showString "writeable (append)"
447 ReadWriteHandle -> showString "read-writeable"
449 instance Show Handle where
450 showsPrec p (Handle h) =
452 #if defined(__CONCURRENT_HASKELL__)
454 hdl_ = unsafePerformIO (primTakeMVar h)
456 -- (Big) SIGH: unfolded defn of takeMVar to avoid
457 -- an (oh-so) unfortunate module loop with PrelConc.
458 hdl_ = unsafePerformIO (IO $ \ s# ->
459 case h of { MVar h# ->
460 case takeMVar# h# s# of { (# s2# , r #) ->
464 hdl_ = unsafePerformIO (stToIO (readVar h))
468 showHdl (haType__ hdl_)
469 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
470 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
471 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
473 showHdl :: Handle__Type -> ShowS -> ShowS
476 ClosedHandle -> showsPrec p ht . showString "}\n"
477 ErrorHandle _ -> showsPrec p ht . showString "}\n"
480 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
483 NoBuffering -> showString "none"
484 LineBuffering -> showString "line"
485 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
486 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
489 def = unsafePerformIO (CCALL(getBufSize) fo)
491 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
492 mkBuffer__ fo sz_in_bytes = do
495 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
497 chunk <- CCALL(allocMemory__) sz_in_bytes
499 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
501 CCALL(setBuf) fo chunk sz_in_bytes
505 %*********************************************************
507 \subsection[BufferMode]{Buffering modes}
509 %*********************************************************
511 Three kinds of buffering are supported: line-buffering,
512 block-buffering or no-buffering. These modes have the following
513 effects. For output, items are written out from the internal
514 buffer according to the buffer mode:
517 \item[line-buffering] the entire output buffer is written
518 out whenever a newline is output, the output buffer overflows,
519 a flush is issued, or the handle is closed.
521 \item[block-buffering] the entire output buffer is written out whenever
522 it overflows, a flush is issued, or the handle
525 \item[no-buffering] output is written immediately, and never stored
526 in the output buffer.
529 The output buffer is emptied as soon as it has been written out.
531 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
533 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
534 the next item is obtained from the buffer;
535 otherwise, when the input buffer is empty,
536 characters up to and including the next newline
537 character are read into the buffer. No characters
538 are available until the newline character is
540 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
541 the next block of data is read into this buffer.
542 \item[no-buffering] the next input item is read and returned.
545 For most implementations, physical files will normally be block-buffered
546 and terminals will normally be line-buffered. (the IO interface provides
547 operations for changing the default buffering of a handle tho.)
551 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
552 deriving (Eq, Ord, Show)
553 {- Read instance defined in IO. -}