1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.15 1999/11/26 16:26:32 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 -- not required but worth having around
79 fixIO :: (a -> IO a) -> IO a
80 fixIO m = stToIO (fixST (ioToST . m))
82 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
83 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
85 bindIO :: IO a -> (a -> IO b) -> IO b
86 bindIO (IO m) k = IO ( \ s ->
88 (# new_s, a #) -> unIO (k a) new_s
94 %*********************************************************
96 \subsection{Coercions to @ST@}
98 %*********************************************************
102 /* Hugs doesn't distinguish these types so no coercion required) */
104 stToIO :: ST RealWorld a -> IO a
105 stToIO (ST m) = (IO m)
107 ioToST :: IO a -> ST RealWorld a
108 ioToST (IO m) = (ST m)
112 %*********************************************************
114 \subsection{Unsafe @IO@ operations}
116 %*********************************************************
120 {-# NOINLINE unsafePerformIO #-}
121 unsafePerformIO :: IO a -> a
122 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
124 unsafeInterleaveIO :: IO a -> IO a
125 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
129 %*********************************************************
131 \subsection{Type @IOError@}
133 %*********************************************************
135 A value @IOError@ encode errors occurred in the @IO@ monad.
136 An @IOError@ records a more specific error type, a descriptive
137 string and maybe the handle that was used when the error was
143 (Maybe Handle) -- the handle used by the action flagging the
145 IOErrorType -- what it was.
147 String -- error type specific information.
149 instance Eq IOError where
150 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
151 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
154 = AlreadyExists | HardwareFault
155 | IllegalOperation | InappropriateType
156 | Interrupted | InvalidArgument
157 | NoSuchThing | OtherError
158 | PermissionDenied | ProtocolError
159 | ResourceBusy | ResourceExhausted
160 | ResourceVanished | SystemError
161 | TimeExpired | UnsatisfiedConstraints
162 | UnsupportedOperation | UserError
165 | ComError Int -- HRESULT
169 instance Show IOErrorType where
173 AlreadyExists -> "already exists"
174 HardwareFault -> "hardware fault"
175 IllegalOperation -> "illegal operation"
176 InappropriateType -> "inappropriate type"
177 Interrupted -> "interrupted"
178 InvalidArgument -> "invalid argument"
179 NoSuchThing -> "does not exist"
180 OtherError -> "failed"
181 PermissionDenied -> "permission denied"
182 ProtocolError -> "protocol error"
183 ResourceBusy -> "resource busy"
184 ResourceExhausted -> "resource exhausted"
185 ResourceVanished -> "resource vanished"
186 SystemError -> "system error"
187 TimeExpired -> "timeout"
188 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
189 UserError -> "failed"
190 UnsupportedOperation -> "unsupported operation"
193 ComError _ -> "COM error"
198 userError :: String -> IOError
199 userError str = IOError Nothing UserError "" str
202 Predicates on IOError; little effort made on these so far...
206 isAlreadyExistsError :: IOError -> Bool
207 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
208 isAlreadyExistsError _ = False
210 isAlreadyInUseError :: IOError -> Bool
211 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
212 isAlreadyInUseError _ = False
214 isFullError :: IOError -> Bool
215 isFullError (IOError _ ResourceExhausted _ _) = True
216 isFullError _ = False
218 isEOFError :: IOError -> Bool
219 isEOFError (IOError _ EOF _ _) = True
222 isIllegalOperation :: IOError -> Bool
223 isIllegalOperation (IOError _ IllegalOperation _ _) = True
224 isIllegalOperation _ = False
226 isPermissionError :: IOError -> Bool
227 isPermissionError (IOError _ PermissionDenied _ _) = True
228 isPermissionError _ = False
230 isDoesNotExistError :: IOError -> Bool
231 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
232 isDoesNotExistError _ = False
234 isUserError :: IOError -> Bool
235 isUserError (IOError _ UserError _ _) = True
236 isUserError _ = False
243 -- For now we give a fairly uninformative error message which just happens to
244 -- be like the ones that Hugs used to give.
245 instance Show IOError where
246 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
248 instance Show IOError where
249 showsPrec p (IOError hdl iot loc s) =
254 _ -> showString "Action: " . showString loc . showChar '\n') .
258 _ -> showString "Reason: " . showString s)
263 Just h -> showString "Handle: " . showsPrec p h
268 The @String@ part of an @IOError@ is platform-dependent. However, to
269 provide a uniform mechanism for distinguishing among errors within
270 these broad categories, each platform-specific standard shall specify
271 the exact strings to be used for particular errors. For errors not
272 explicitly mentioned in the standard, any descriptive string may be
276 constructErrorAndFail :: String -> IO a
277 constructErrorAndFail call_site
278 = constructError call_site >>= \ io_error ->
281 constructErrorAndFailWithInfo :: String -> String -> IO a
282 constructErrorAndFailWithInfo call_site reason
283 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
288 This doesn't seem to be documented/spelled out anywhere,
291 The implementation of the IO prelude uses various C stubs
292 to do the actual interaction with the OS. The bandwidth
293 \tr{C<->Haskell} is somewhat limited, so the general strategy
294 for flaggging any errors (apart from possibly using the
295 return code of the external call), is to set the @ghc_errtype@
296 to a value that is one of the \tr{#define}s in @includes/error.h@.
297 @ghc_errstr@ holds a character string providing error-specific
298 information. Error constructing functions will then reach out
299 and grab these values when generating
302 constructError :: String -> IO IOError
303 constructError call_site = constructErrorMsg call_site Nothing
305 constructErrorMsg :: String -> Maybe String -> IO IOError
306 constructErrorMsg call_site reason =
307 getErrType__ >>= \ errtype ->
308 getErrStr__ >>= \ str ->
311 case (errtype::Int) of
312 ERR_ALREADYEXISTS -> AlreadyExists
313 ERR_HARDWAREFAULT -> HardwareFault
314 ERR_ILLEGALOPERATION -> IllegalOperation
315 ERR_INAPPROPRIATETYPE -> InappropriateType
316 ERR_INTERRUPTED -> Interrupted
317 ERR_INVALIDARGUMENT -> InvalidArgument
318 ERR_NOSUCHTHING -> NoSuchThing
319 ERR_OTHERERROR -> OtherError
320 ERR_PERMISSIONDENIED -> PermissionDenied
321 ERR_PROTOCOLERROR -> ProtocolError
322 ERR_RESOURCEBUSY -> ResourceBusy
323 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
324 ERR_RESOURCEVANISHED -> ResourceVanished
325 ERR_SYSTEMERROR -> SystemError
326 ERR_TIMEEXPIRED -> TimeExpired
327 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
328 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
335 OtherError -> "(error code: " ++ show errtype ++ ")"
341 return (IOError Nothing iot call_site msg)
344 File names are specified using @FilePath@, a OS-dependent
345 string that (hopefully, I guess) maps to an accessible file/object.
348 type FilePath = String
351 %*********************************************************
353 \subsection{Types @Handle@, @Handle__@}
355 %*********************************************************
357 The type for @Handle@ is defined rather than in @IOHandle@
358 module, as the @IOError@ type uses it..all operations over
359 a handles reside in @IOHandle@.
365 Sigh, the MVar ops in ConcBase depend on IO, the IO
366 representation here depend on MVars for handles (when
367 compiling in a concurrent way). Break the cycle by having
368 the definition of MVars go here:
371 data MVar a = MVar (MVar# RealWorld a)
373 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
374 instance Eq (MVar a) where
375 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
378 Double sigh - ForeignObj is needed here too to break a cycle.
380 data ForeignObj = ForeignObj ForeignObj# -- another one
381 instance CCallable ForeignObj
383 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
385 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
387 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
389 instance Eq ForeignObj where
390 p == q = eqForeignObj p q
391 p /= q = not (eqForeignObj p q)
392 #endif /* ndef __HUGS__ */
394 #if defined(__CONCURRENT_HASKELL__)
395 newtype Handle = Handle (MVar Handle__)
397 newtype Handle = Handle (MutableVar RealWorld Handle__)
400 instance Eq Handle where
401 (Handle h1) == (Handle h2) = h1 == h2
404 A Handle is represented by (a reference to) a record
405 containing the state of the I/O port/device. We record
406 the following pieces of info:
408 * type (read,write,closed etc.)
409 * pointer to the external file object.
411 * user-friendly name (usually the
412 FilePath used when IO.openFile was called)
414 Note: when a Handle is garbage collected, we want to flush its buffer
415 and close the OS file handle, so as to free up a (precious) resource.
419 haFO__ :: FILE_OBJECT,
420 haType__ :: Handle__Type,
421 haBufferMode__ :: BufferMode,
422 haFilePath__ :: FilePath
426 Internally, we classify handles as being one
430 = ErrorHandle IOError
439 -- handle types are 'show'ed when printing error msgs, so
440 -- we provide a more user-friendly Show instance for it
441 -- than the derived one.
442 instance Show Handle__Type where
445 ErrorHandle iot -> showString "error " . showsPrec p iot
446 ClosedHandle -> showString "closed"
447 SemiClosedHandle -> showString "semi-closed"
448 ReadHandle -> showString "readable"
449 WriteHandle -> showString "writeable"
450 AppendHandle -> showString "writeable (append)"
451 ReadWriteHandle -> showString "read-writeable"
453 instance Show Handle where
454 showsPrec p (Handle h) =
456 #if defined(__CONCURRENT_HASKELL__)
458 hdl_ = unsafePerformIO (primTakeMVar h)
460 -- (Big) SIGH: unfolded defn of takeMVar to avoid
461 -- an (oh-so) unfortunate module loop with PrelConc.
462 hdl_ = unsafePerformIO (IO $ \ s# ->
463 case h of { MVar h# ->
464 case takeMVar# h# s# of { (# s2# , r #) ->
468 hdl_ = unsafePerformIO (stToIO (readVar h))
472 showHdl (haType__ hdl_)
473 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
474 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
475 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
477 showHdl :: Handle__Type -> ShowS -> ShowS
480 ClosedHandle -> showsPrec p ht . showString "}\n"
481 ErrorHandle _ -> showsPrec p ht . showString "}\n"
484 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
487 NoBuffering -> showString "none"
488 LineBuffering -> showString "line"
489 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
490 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
493 def = unsafePerformIO (getBufSize fo)
495 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
496 mkBuffer__ fo sz_in_bytes = do
499 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
501 chunk <- allocMemory__ sz_in_bytes
503 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
505 setBuf fo chunk sz_in_bytes
509 %*********************************************************
511 \subsection[BufferMode]{Buffering modes}
513 %*********************************************************
515 Three kinds of buffering are supported: line-buffering,
516 block-buffering or no-buffering. These modes have the following
517 effects. For output, items are written out from the internal
518 buffer according to the buffer mode:
521 \item[line-buffering] the entire output buffer is written
522 out whenever a newline is output, the output buffer overflows,
523 a flush is issued, or the handle is closed.
525 \item[block-buffering] the entire output buffer is written out whenever
526 it overflows, a flush is issued, or the handle
529 \item[no-buffering] output is written immediately, and never stored
530 in the output buffer.
533 The output buffer is emptied as soon as it has been written out.
535 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
537 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
538 the next item is obtained from the buffer;
539 otherwise, when the input buffer is empty,
540 characters up to and including the next newline
541 character are read into the buffer. No characters
542 are available until the newline character is
544 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
545 the next block of data is read into this buffer.
546 \item[no-buffering] the next input item is read and returned.
549 For most implementations, physical files will normally be block-buffered
550 and terminals will normally be line-buffered. (the IO interface provides
551 operations for changing the default buffering of a handle tho.)
555 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
556 deriving (Eq, Ord, Show)
557 {- Read instance defined in IO. -}
561 Foreign import declarations to helper routines:
564 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
565 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
566 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
568 foreign import "libHS_cbits" "allocMemory__" unsafe
569 allocMemory__ :: Int -> IO Addr
570 foreign import "libHS_cbits" "getBufSize" unsafe
571 getBufSize :: FILE_OBJECT -> IO Int
572 foreign import "libHS_cbits" "setBuf" unsafe
573 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()