1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.11 1999/06/12 16:17:26 keithw 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 )
30 #if !defined(__CONCURRENT_HASKELL__)
31 import PrelArr ( MutableVar, readVar )
36 #define cat2(x,y) x##y
37 #define CCALL(fun) cat2(prim_,fun)
38 #define __CONCURRENT_HASKELL__
40 #define unpackCString primUnpackString
42 #define CCALL(fun) _ccall_ fun
43 #define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
46 #ifndef __PARALLEL_HASKELL__
47 #define FILE_OBJECT ForeignObj
49 #define FILE_OBJECT Addr
53 %*********************************************************
55 \subsection{The @IO@ monad}
57 %*********************************************************
59 The IO Monad is just an instance of the ST monad, where the state is
60 the real world. We use the exception mechanism (in PrelException) to
61 implement IO exceptions.
65 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
67 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
70 instance Functor IO where
71 fmap f x = x >>= (return . f)
73 instance Monad IO where
77 m >> k = m >>= \ _ -> k
78 return x = IO $ \ s -> (# s, x #)
81 fail s = error s -- not ioError?
83 -- not required but worth having around
84 fixIO :: (a -> IO a) -> IO a
85 fixIO m = stToIO (fixST (ioToST . m))
87 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
88 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
90 bindIO :: IO a -> (a -> IO b) -> IO b
91 bindIO (IO m) k = IO ( \ s ->
93 (# new_s, a #) -> unIO (k a) new_s
99 %*********************************************************
101 \subsection{Coercions to @ST@}
103 %*********************************************************
107 /* Hugs doesn't distinguish these types so no coercion required) */
109 stToIO :: ST RealWorld a -> IO a
110 stToIO (ST m) = (IO m)
112 ioToST :: IO a -> ST RealWorld a
113 ioToST (IO m) = (ST m)
117 %*********************************************************
119 \subsection{Unsafe @IO@ operations}
121 %*********************************************************
125 {-# NOINLINE unsafePerformIO #-}
126 unsafePerformIO :: IO a -> a
127 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
129 unsafeInterleaveIO :: IO a -> IO a
130 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
134 %*********************************************************
136 \subsection{Type @IOError@}
138 %*********************************************************
140 A value @IOError@ encode errors occurred in the @IO@ monad.
141 An @IOError@ records a more specific error type, a descriptive
142 string and maybe the handle that was used when the error was
148 (Maybe Handle) -- the handle used by the action flagging the
150 IOErrorType -- what it was.
152 String -- error type specific information.
156 = AlreadyExists | HardwareFault
157 | IllegalOperation | InappropriateType
158 | Interrupted | InvalidArgument
159 | NoSuchThing | OtherError
160 | PermissionDenied | ProtocolError
161 | ResourceBusy | ResourceExhausted
162 | ResourceVanished | SystemError
163 | TimeExpired | UnsatisfiedConstraints
164 | UnsupportedOperation | UserError
167 | ComError Int -- HRESULT
171 instance Show IOErrorType where
175 AlreadyExists -> "already exists"
176 HardwareFault -> "hardware fault"
177 IllegalOperation -> "illegal operation"
178 InappropriateType -> "inappropriate type"
179 Interrupted -> "interrupted"
180 InvalidArgument -> "invalid argument"
181 NoSuchThing -> "does not exist"
182 OtherError -> "failed"
183 PermissionDenied -> "permission denied"
184 ProtocolError -> "protocol error"
185 ResourceBusy -> "resource busy"
186 ResourceExhausted -> "resource exhausted"
187 ResourceVanished -> "resource vanished"
188 SystemError -> "system error"
189 TimeExpired -> "timeout"
190 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
191 UserError -> "failed"
192 UnsupportedOperation -> "unsupported operation"
195 ComError _ -> "COM error"
200 userError :: String -> IOError
201 userError str = IOError Nothing UserError "" str
204 Predicates on IOError; little effort made on these so far...
208 isAlreadyExistsError :: IOError -> Bool
209 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
210 isAlreadyExistsError _ = False
212 isAlreadyInUseError :: IOError -> Bool
213 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
214 isAlreadyInUseError _ = False
216 isFullError :: IOError -> Bool
217 isFullError (IOError _ ResourceExhausted _ _) = True
218 isFullError _ = False
220 isEOFError :: IOError -> Bool
221 isEOFError (IOError _ EOF _ _) = True
224 isIllegalOperation :: IOError -> Bool
225 isIllegalOperation (IOError _ IllegalOperation _ _) = True
226 isIllegalOperation _ = False
228 isPermissionError :: IOError -> Bool
229 isPermissionError (IOError _ PermissionDenied _ _) = True
230 isPermissionError _ = False
232 isDoesNotExistError :: IOError -> Bool
233 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
234 isDoesNotExistError _ = False
236 isUserError :: IOError -> Bool
237 isUserError (IOError _ UserError _ _) = True
238 isUserError _ = False
245 -- For now we give a fairly uninformative error message which just happens to
246 -- be like the ones that Hugs used to give.
247 instance Show IOError where
248 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
250 instance Show IOError where
251 showsPrec p (IOError hdl iot loc s) =
256 _ -> showString "Action: " . showString loc . showChar '\n') .
260 _ -> showString "Reason: " . showString s)
265 Just h -> showString "Handle: " . showsPrec p h
270 The @String@ part of an @IOError@ is platform-dependent. However, to
271 provide a uniform mechanism for distinguishing among errors within
272 these broad categories, each platform-specific standard shall specify
273 the exact strings to be used for particular errors. For errors not
274 explicitly mentioned in the standard, any descriptive string may be
278 constructErrorAndFail :: String -> IO a
279 constructErrorAndFail call_site
280 = constructError call_site >>= \ io_error ->
283 constructErrorAndFailWithInfo :: String -> String -> IO a
284 constructErrorAndFailWithInfo call_site reason
285 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
290 This doesn't seem to be documented/spelled out anywhere,
293 The implementation of the IO prelude uses various C stubs
294 to do the actual interaction with the OS. The bandwidth
295 \tr{C<->Haskell} is somewhat limited, so the general strategy
296 for flaggging any errors (apart from possibly using the
297 return code of the external call), is to set the @ghc_errtype@
298 to a value that is one of the \tr{#define}s in @includes/error.h@.
299 @ghc_errstr@ holds a character string providing error-specific
300 information. Error constructing functions will then reach out
301 and grab these values when generating
304 constructError :: String -> IO IOError
305 constructError call_site = constructErrorMsg call_site Nothing
307 constructErrorMsg :: String -> Maybe String -> IO IOError
308 constructErrorMsg call_site reason =
309 CCALL(getErrType__) >>= \ errtype ->
310 CCALL(getErrStr__) >>= \ str ->
313 case (errtype::Int) of
314 ERR_ALREADYEXISTS -> AlreadyExists
315 ERR_HARDWAREFAULT -> HardwareFault
316 ERR_ILLEGALOPERATION -> IllegalOperation
317 ERR_INAPPROPRIATETYPE -> InappropriateType
318 ERR_INTERRUPTED -> Interrupted
319 ERR_INVALIDARGUMENT -> InvalidArgument
320 ERR_NOSUCHTHING -> NoSuchThing
321 ERR_OTHERERROR -> OtherError
322 ERR_PERMISSIONDENIED -> PermissionDenied
323 ERR_PROTOCOLERROR -> ProtocolError
324 ERR_RESOURCEBUSY -> ResourceBusy
325 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
326 ERR_RESOURCEVANISHED -> ResourceVanished
327 ERR_SYSTEMERROR -> SystemError
328 ERR_TIMEEXPIRED -> TimeExpired
329 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
330 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
337 OtherError -> "(error code: " ++ show errtype ++ ")"
343 return (IOError Nothing iot call_site msg)
346 File names are specified using @FilePath@, a OS-dependent
347 string that (hopefully, I guess) maps to an accessible file/object.
350 type FilePath = String
353 %*********************************************************
355 \subsection{Types @Handle@, @Handle__@}
357 %*********************************************************
359 The type for @Handle@ is defined rather than in @IOHandle@
360 module, as the @IOError@ type uses it..all operations over
361 a handles reside in @IOHandle@.
367 Sigh, the MVar ops in ConcBase depend on IO, the IO
368 representation here depend on MVars for handles (when
369 compiling in a concurrent way). Break the cycle by having
370 the definition of MVars go here:
373 data MVar a = MVar (MVar# RealWorld a)
376 Double sigh - ForeignObj is needed here too to break a cycle.
378 data ForeignObj = ForeignObj ForeignObj# -- another one
379 instance CCallable ForeignObj
380 instance CCallable ForeignObj#
381 #endif /* ndef __HUGS__ */
383 #if defined(__CONCURRENT_HASKELL__)
384 newtype Handle = Handle (MVar Handle__)
386 newtype Handle = Handle (MutableVar RealWorld Handle__)
390 A Handle is represented by (a reference to) a record
391 containing the state of the I/O port/device. We record
392 the following pieces of info:
394 * type (read,write,closed etc.)
395 * pointer to the external file object.
397 * user-friendly name (usually the
398 FilePath used when IO.openFile was called)
400 Note: when a Handle is garbage collected, we want to flush its buffer
401 and close the OS file handle, so as to free up a (precious) resource.
405 haFO__ :: FILE_OBJECT,
406 haType__ :: Handle__Type,
407 haBufferMode__ :: BufferMode,
408 haFilePath__ :: FilePath
412 Internally, we classify handles as being one
416 = ErrorHandle IOError
425 -- handle types are 'show'ed when printing error msgs, so
426 -- we provide a more user-friendly Show instance for it
427 -- than the derived one.
428 instance Show Handle__Type where
431 ErrorHandle iot -> showString "error " . showsPrec p iot
432 ClosedHandle -> showString "closed"
433 SemiClosedHandle -> showString "semi-closed"
434 ReadHandle -> showString "readable"
435 WriteHandle -> showString "writeable"
436 AppendHandle -> showString "writeable (append)"
437 ReadWriteHandle -> showString "read-writeable"
439 instance Show Handle where
440 showsPrec p (Handle h) =
442 #if defined(__CONCURRENT_HASKELL__)
444 hdl_ = unsafePerformIO (primTakeMVar h)
446 -- (Big) SIGH: unfolded defn of takeMVar to avoid
447 -- an (oh-so) unfortunate module loop with PrelConc.
448 hdl_ = unsafePerformIO (IO $ \ s# ->
449 case h of { MVar h# ->
450 case takeMVar# h# s# of { (# s2# , r #) ->
454 hdl_ = unsafePerformIO (stToIO (readVar h))
458 showHdl (haType__ hdl_)
459 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
460 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
461 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
463 showHdl :: Handle__Type -> ShowS -> ShowS
466 ClosedHandle -> showsPrec p ht . showString "}\n"
467 ErrorHandle _ -> showsPrec p ht . showString "}\n"
470 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
473 NoBuffering -> showString "none"
474 LineBuffering -> showString "line"
475 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
476 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
479 def = unsafePerformIO (CCALL(getBufSize) fo)
481 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
482 mkBuffer__ fo sz_in_bytes = do
485 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
487 chunk <- CCALL(allocMemory__) sz_in_bytes
489 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
491 CCALL(setBuf) fo chunk sz_in_bytes
495 %*********************************************************
497 \subsection[BufferMode]{Buffering modes}
499 %*********************************************************
501 Three kinds of buffering are supported: line-buffering,
502 block-buffering or no-buffering. These modes have the following
503 effects. For output, items are written out from the internal
504 buffer according to the buffer mode:
507 \item[line-buffering] the entire output buffer is written
508 out whenever a newline is output, the output buffer overflows,
509 a flush is issued, or the handle is closed.
511 \item[block-buffering] the entire output buffer is written out whenever
512 it overflows, a flush is issued, or the handle
515 \item[no-buffering] output is written immediately, and never stored
516 in the output buffer.
519 The output buffer is emptied as soon as it has been written out.
521 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
523 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
524 the next item is obtained from the buffer;
525 otherwise, when the input buffer is empty,
526 characters up to and including the next newline
527 character are read into the buffer. No characters
528 are available until the newline character is
530 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
531 the next block of data is read into this buffer.
532 \item[no-buffering] the next input item is read and returned.
535 For most implementations, physical files will normally be block-buffered
536 and terminals will normally be line-buffered. (the IO interface provides
537 operations for changing the default buffering of a handle tho.)
541 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
542 deriving (Eq, Ord, Show)
543 {- Read instance defined in IO. -}