1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.16 1999/12/03 16:17:42 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"
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 __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.
60 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
62 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
65 instance Functor IO where
66 fmap f x = x >>= (return . f)
68 instance Monad IO where
72 m >> k = m >>= \ _ -> k
73 return x = IO $ \ s -> (# s, x #)
76 fail s = error s -- not ioError?
78 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
79 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
81 bindIO :: IO a -> (a -> IO b) -> IO b
82 bindIO (IO m) k = IO ( \ s ->
84 (# new_s, a #) -> unIO (k a) new_s
90 %*********************************************************
92 \subsection{Coercions to @ST@}
94 %*********************************************************
98 /* Hugs doesn't distinguish these types so no coercion required) */
100 stToIO :: ST RealWorld a -> IO a
101 stToIO (ST m) = (IO m)
103 ioToST :: IO a -> ST RealWorld a
104 ioToST (IO m) = (ST m)
108 %*********************************************************
110 \subsection{Unsafe @IO@ operations}
112 %*********************************************************
116 {-# NOINLINE unsafePerformIO #-}
117 unsafePerformIO :: IO a -> a
118 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
120 unsafeInterleaveIO :: IO a -> IO a
121 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
125 %*********************************************************
127 \subsection{Type @IOError@}
129 %*********************************************************
131 A value @IOError@ encode errors occurred in the @IO@ monad.
132 An @IOError@ records a more specific error type, a descriptive
133 string and maybe the handle that was used when the error was
139 (Maybe Handle) -- the handle used by the action flagging the
141 IOErrorType -- what it was.
143 String -- error type specific information.
145 instance Eq IOError where
146 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
147 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
150 = AlreadyExists | HardwareFault
151 | IllegalOperation | InappropriateType
152 | Interrupted | InvalidArgument
153 | NoSuchThing | OtherError
154 | PermissionDenied | ProtocolError
155 | ResourceBusy | ResourceExhausted
156 | ResourceVanished | SystemError
157 | TimeExpired | UnsatisfiedConstraints
158 | UnsupportedOperation | UserError
161 | ComError Int -- HRESULT
165 instance Show IOErrorType where
169 AlreadyExists -> "already exists"
170 HardwareFault -> "hardware fault"
171 IllegalOperation -> "illegal operation"
172 InappropriateType -> "inappropriate type"
173 Interrupted -> "interrupted"
174 InvalidArgument -> "invalid argument"
175 NoSuchThing -> "does not exist"
176 OtherError -> "failed"
177 PermissionDenied -> "permission denied"
178 ProtocolError -> "protocol error"
179 ResourceBusy -> "resource busy"
180 ResourceExhausted -> "resource exhausted"
181 ResourceVanished -> "resource vanished"
182 SystemError -> "system error"
183 TimeExpired -> "timeout"
184 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
185 UserError -> "failed"
186 UnsupportedOperation -> "unsupported operation"
189 ComError _ -> "COM error"
194 userError :: String -> IOError
195 userError str = IOError Nothing UserError "" str
198 Predicates on IOError; little effort made on these so far...
202 isAlreadyExistsError :: IOError -> Bool
203 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
204 isAlreadyExistsError _ = False
206 isAlreadyInUseError :: IOError -> Bool
207 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
208 isAlreadyInUseError _ = False
210 isFullError :: IOError -> Bool
211 isFullError (IOError _ ResourceExhausted _ _) = True
212 isFullError _ = False
214 isEOFError :: IOError -> Bool
215 isEOFError (IOError _ EOF _ _) = True
218 isIllegalOperation :: IOError -> Bool
219 isIllegalOperation (IOError _ IllegalOperation _ _) = True
220 isIllegalOperation _ = False
222 isPermissionError :: IOError -> Bool
223 isPermissionError (IOError _ PermissionDenied _ _) = True
224 isPermissionError _ = False
226 isDoesNotExistError :: IOError -> Bool
227 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
228 isDoesNotExistError _ = False
230 isUserError :: IOError -> Bool
231 isUserError (IOError _ UserError _ _) = True
232 isUserError _ = False
239 -- For now we give a fairly uninformative error message which just happens to
240 -- be like the ones that Hugs used to give.
241 instance Show IOError where
242 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
244 instance Show IOError where
245 showsPrec p (IOError hdl iot loc s) =
250 _ -> showString "Action: " . showString loc . showChar '\n') .
254 _ -> showString "Reason: " . showString s)
259 Just h -> showString "Handle: " . showsPrec p h
264 The @String@ part of an @IOError@ is platform-dependent. However, to
265 provide a uniform mechanism for distinguishing among errors within
266 these broad categories, each platform-specific standard shall specify
267 the exact strings to be used for particular errors. For errors not
268 explicitly mentioned in the standard, any descriptive string may be
272 constructErrorAndFail :: String -> IO a
273 constructErrorAndFail call_site
274 = constructError call_site >>= \ io_error ->
277 constructErrorAndFailWithInfo :: String -> String -> IO a
278 constructErrorAndFailWithInfo call_site reason
279 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
284 This doesn't seem to be documented/spelled out anywhere,
287 The implementation of the IO prelude uses various C stubs
288 to do the actual interaction with the OS. The bandwidth
289 \tr{C<->Haskell} is somewhat limited, so the general strategy
290 for flaggging any errors (apart from possibly using the
291 return code of the external call), is to set the @ghc_errtype@
292 to a value that is one of the \tr{#define}s in @includes/error.h@.
293 @ghc_errstr@ holds a character string providing error-specific
294 information. Error constructing functions will then reach out
295 and grab these values when generating
298 constructError :: String -> IO IOError
299 constructError call_site = constructErrorMsg call_site Nothing
301 constructErrorMsg :: String -> Maybe String -> IO IOError
302 constructErrorMsg call_site reason =
303 getErrType__ >>= \ errtype ->
304 getErrStr__ >>= \ str ->
307 case (errtype::Int) of
308 ERR_ALREADYEXISTS -> AlreadyExists
309 ERR_HARDWAREFAULT -> HardwareFault
310 ERR_ILLEGALOPERATION -> IllegalOperation
311 ERR_INAPPROPRIATETYPE -> InappropriateType
312 ERR_INTERRUPTED -> Interrupted
313 ERR_INVALIDARGUMENT -> InvalidArgument
314 ERR_NOSUCHTHING -> NoSuchThing
315 ERR_OTHERERROR -> OtherError
316 ERR_PERMISSIONDENIED -> PermissionDenied
317 ERR_PROTOCOLERROR -> ProtocolError
318 ERR_RESOURCEBUSY -> ResourceBusy
319 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
320 ERR_RESOURCEVANISHED -> ResourceVanished
321 ERR_SYSTEMERROR -> SystemError
322 ERR_TIMEEXPIRED -> TimeExpired
323 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
324 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
331 OtherError -> "(error code: " ++ show errtype ++ ")"
337 return (IOError Nothing iot call_site msg)
340 File names are specified using @FilePath@, a OS-dependent
341 string that (hopefully, I guess) maps to an accessible file/object.
344 type FilePath = String
347 %*********************************************************
349 \subsection{Types @Handle@, @Handle__@}
351 %*********************************************************
353 The type for @Handle@ is defined rather than in @IOHandle@
354 module, as the @IOError@ type uses it..all operations over
355 a handles reside in @IOHandle@.
361 Sigh, the MVar ops in ConcBase depend on IO, the IO
362 representation here depend on MVars for handles (when
363 compiling in a concurrent way). Break the cycle by having
364 the definition of MVars go here:
367 data MVar a = MVar (MVar# RealWorld a)
369 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
370 instance Eq (MVar a) where
371 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
374 Double sigh - ForeignObj is needed here too to break a cycle.
376 data ForeignObj = ForeignObj ForeignObj# -- another one
377 instance CCallable ForeignObj
379 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
381 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
383 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
385 instance Eq ForeignObj where
386 p == q = eqForeignObj p q
387 p /= q = not (eqForeignObj p q)
388 #endif /* ndef __HUGS__ */
390 #if defined(__CONCURRENT_HASKELL__)
391 newtype Handle = Handle (MVar Handle__)
393 newtype Handle = Handle (MutableVar RealWorld Handle__)
396 instance Eq Handle where
397 (Handle h1) == (Handle h2) = h1 == h2
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 (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 <- allocMemory__ sz_in_bytes
499 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
501 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. -}
557 Foreign import declarations to helper routines:
560 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
561 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
562 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
564 foreign import "libHS_cbits" "allocMemory__" unsafe
565 allocMemory__ :: Int -> IO Addr
566 foreign import "libHS_cbits" "getBufSize" unsafe
567 getBufSize :: FILE_OBJECT -> IO Int
568 foreign import "libHS_cbits" "setBuf" unsafe
569 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()