1 % -----------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.23 2000/04/14 15:28:24 rrt 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"
17 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
18 module PrelIOBase where
20 import {-# SOURCE #-} PrelErr ( error )
24 import {-# SOURCE #-} PrelException ( ioError )
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.
58 NOTE: The IO representation is deeply wired in to various parts of the
59 system. The following list may or may not be exhaustive:
61 Compiler - types of various primitives in PrimOp.lhs
63 RTS - forceIO (StgMiscClosures.hc)
64 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
66 - raiseAsync (Schedule.c)
68 Prelude - PrelIOBase.lhs, and several other places including
71 Libraries - parts of hslibs/lang.
77 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
79 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
82 instance Functor IO where
83 fmap f x = x >>= (return . f)
85 instance Monad IO where
89 m >> k = m >>= \ _ -> k
93 fail s = error s -- not ioError?
95 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
96 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
98 bindIO :: IO a -> (a -> IO b) -> IO b
99 bindIO (IO m) k = IO ( \ s ->
101 (# new_s, a #) -> unIO (k a) new_s
104 returnIO :: a -> IO a
105 returnIO x = IO (\ s -> (# s, x #))
109 %*********************************************************
111 \subsection{Coercions to @ST@}
113 %*********************************************************
117 /* Hugs doesn't distinguish these types so no coercion required) */
119 stToIO :: ST RealWorld a -> IO a
120 stToIO (ST m) = (IO m)
122 ioToST :: IO a -> ST RealWorld a
123 ioToST (IO m) = (ST m)
127 %*********************************************************
129 \subsection{Unsafe @IO@ operations}
131 %*********************************************************
135 {-# NOINLINE unsafePerformIO #-}
136 unsafePerformIO :: IO a -> a
137 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
139 unsafeInterleaveIO :: IO a -> IO a
140 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
144 %*********************************************************
146 \subsection{Type @IOError@}
148 %*********************************************************
150 A value @IOError@ encode errors occurred in the @IO@ monad.
151 An @IOError@ records a more specific error type, a descriptive
152 string and maybe the handle that was used when the error was
158 (Maybe Handle) -- the handle used by the action flagging the
160 IOErrorType -- what it was.
162 String -- error type specific information.
164 instance Eq IOError where
165 (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
166 e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
169 = AlreadyExists | HardwareFault
170 | IllegalOperation | InappropriateType
171 | Interrupted | InvalidArgument
172 | NoSuchThing | OtherError
173 | PermissionDenied | ProtocolError
174 | ResourceBusy | ResourceExhausted
175 | ResourceVanished | SystemError
176 | TimeExpired | UnsatisfiedConstraints
177 | UnsupportedOperation | UserError
179 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
180 | ComError Int -- HRESULT
184 instance Show IOErrorType where
188 AlreadyExists -> "already exists"
189 HardwareFault -> "hardware fault"
190 IllegalOperation -> "illegal operation"
191 InappropriateType -> "inappropriate type"
192 Interrupted -> "interrupted"
193 InvalidArgument -> "invalid argument"
194 NoSuchThing -> "does not exist"
195 OtherError -> "failed"
196 PermissionDenied -> "permission denied"
197 ProtocolError -> "protocol error"
198 ResourceBusy -> "resource busy"
199 ResourceExhausted -> "resource exhausted"
200 ResourceVanished -> "resource vanished"
201 SystemError -> "system error"
202 TimeExpired -> "timeout"
203 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
204 UserError -> "failed"
205 UnsupportedOperation -> "unsupported operation"
207 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
208 ComError _ -> "COM error"
213 userError :: String -> IOError
214 userError str = IOError Nothing UserError "" str
217 Predicates on IOError; little effort made on these so far...
221 isAlreadyExistsError :: IOError -> Bool
222 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
223 isAlreadyExistsError _ = False
225 isAlreadyInUseError :: IOError -> Bool
226 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
227 isAlreadyInUseError _ = False
229 isFullError :: IOError -> Bool
230 isFullError (IOError _ ResourceExhausted _ _) = True
231 isFullError _ = False
233 isEOFError :: IOError -> Bool
234 isEOFError (IOError _ EOF _ _) = True
237 isIllegalOperation :: IOError -> Bool
238 isIllegalOperation (IOError _ IllegalOperation _ _) = True
239 isIllegalOperation _ = False
241 isPermissionError :: IOError -> Bool
242 isPermissionError (IOError _ PermissionDenied _ _) = True
243 isPermissionError _ = False
245 isDoesNotExistError :: IOError -> Bool
246 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
247 isDoesNotExistError _ = False
249 isUserError :: IOError -> Bool
250 isUserError (IOError _ UserError _ _) = True
251 isUserError _ = False
258 -- For now we give a fairly uninformative error message which just happens to
259 -- be like the ones that Hugs used to give.
260 instance Show IOError where
261 showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
263 instance Show IOError where
264 showsPrec p (IOError hdl iot loc s) =
269 _ -> showString "Action: " . showString loc . showChar '\n') .
273 _ -> showString "Reason: " . showString s)
278 Just h -> showString "Handle: " . showsPrec p h
283 The @String@ part of an @IOError@ is platform-dependent. However, to
284 provide a uniform mechanism for distinguishing among errors within
285 these broad categories, each platform-specific standard shall specify
286 the exact strings to be used for particular errors. For errors not
287 explicitly mentioned in the standard, any descriptive string may be
291 constructErrorAndFail :: String -> IO a
292 constructErrorAndFail call_site
293 = constructError call_site >>= \ io_error ->
296 constructErrorAndFailWithInfo :: String -> String -> IO a
297 constructErrorAndFailWithInfo call_site reason
298 = constructErrorMsg call_site (Just reason) >>= \ io_error ->
303 This doesn't seem to be documented/spelled out anywhere,
306 The implementation of the IO prelude uses various C stubs
307 to do the actual interaction with the OS. The bandwidth
308 \tr{C<->Haskell} is somewhat limited, so the general strategy
309 for flaggging any errors (apart from possibly using the
310 return code of the external call), is to set the @ghc_errtype@
311 to a value that is one of the \tr{#define}s in @includes/error.h@.
312 @ghc_errstr@ holds a character string providing error-specific
313 information. Error constructing functions will then reach out
314 and grab these values when generating
317 constructError :: String -> IO IOError
318 constructError call_site = constructErrorMsg call_site Nothing
320 constructErrorMsg :: String -> Maybe String -> IO IOError
321 constructErrorMsg call_site reason =
322 getErrType__ >>= \ errtype ->
323 getErrStr__ >>= \ str ->
326 case (errtype::Int) of
327 ERR_ALREADYEXISTS -> AlreadyExists
328 ERR_HARDWAREFAULT -> HardwareFault
329 ERR_ILLEGALOPERATION -> IllegalOperation
330 ERR_INAPPROPRIATETYPE -> InappropriateType
331 ERR_INTERRUPTED -> Interrupted
332 ERR_INVALIDARGUMENT -> InvalidArgument
333 ERR_NOSUCHTHING -> NoSuchThing
334 ERR_OTHERERROR -> OtherError
335 ERR_PERMISSIONDENIED -> PermissionDenied
336 ERR_PROTOCOLERROR -> ProtocolError
337 ERR_RESOURCEBUSY -> ResourceBusy
338 ERR_RESOURCEEXHAUSTED -> ResourceExhausted
339 ERR_RESOURCEVANISHED -> ResourceVanished
340 ERR_SYSTEMERROR -> SystemError
341 ERR_TIMEEXPIRED -> TimeExpired
342 ERR_UNSATISFIEDCONSTRAINTS -> UnsatisfiedConstraints
343 ERR_UNSUPPORTEDOPERATION -> UnsupportedOperation
350 OtherError -> "(error code: " ++ show errtype ++ ")"
356 return (IOError Nothing iot call_site msg)
359 File names are specified using @FilePath@, a OS-dependent
360 string that (hopefully, I guess) maps to an accessible file/object.
363 type FilePath = String
366 %*********************************************************
368 \subsection{Types @Handle@, @Handle__@}
370 %*********************************************************
372 The type for @Handle@ is defined rather than in @IOHandle@
373 module, as the @IOError@ type uses it..all operations over
374 a handles reside in @IOHandle@.
380 Sigh, the MVar ops in ConcBase depend on IO, the IO
381 representation here depend on MVars for handles (when
382 compiling in a concurrent way). Break the cycle by having
383 the definition of MVars go here:
386 data MVar a = MVar (MVar# RealWorld a)
388 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
389 instance Eq (MVar a) where
390 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
393 Double sigh - ForeignObj is needed here too to break a cycle.
395 data ForeignObj = ForeignObj ForeignObj# -- another one
396 instance CCallable ForeignObj
398 eqForeignObj :: ForeignObj -> ForeignObj -> Bool
400 = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
402 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
404 instance Eq ForeignObj where
405 p == q = eqForeignObj p q
406 p /= q = not (eqForeignObj p q)
407 #endif /* ndef __HUGS__ */
409 #if defined(__CONCURRENT_HASKELL__)
410 newtype Handle = Handle (MVar Handle__)
412 newtype Handle = Handle (MutableVar RealWorld Handle__)
415 instance Eq Handle where
416 (Handle h1) == (Handle h2) = h1 == h2
419 A Handle is represented by (a reference to) a record
420 containing the state of the I/O port/device. We record
421 the following pieces of info:
423 * type (read,write,closed etc.)
424 * pointer to the external file object.
426 * user-friendly name (usually the
427 FilePath used when IO.openFile was called)
429 Note: when a Handle is garbage collected, we want to flush its buffer
430 and close the OS file handle, so as to free up a (precious) resource.
434 haFO__ :: FILE_OBJECT,
435 haType__ :: Handle__Type,
436 haBufferMode__ :: BufferMode,
437 haFilePath__ :: FilePath,
438 haBuffers__ :: [Addr]
442 Internally, we classify handles as being one
446 = ErrorHandle IOError
455 -- handle types are 'show'ed when printing error msgs, so
456 -- we provide a more user-friendly Show instance for it
457 -- than the derived one.
458 instance Show Handle__Type where
461 ErrorHandle iot -> showString "error " . showsPrec p iot
462 ClosedHandle -> showString "closed"
463 SemiClosedHandle -> showString "semi-closed"
464 ReadHandle -> showString "readable"
465 WriteHandle -> showString "writeable"
466 AppendHandle -> showString "writeable (append)"
467 ReadWriteHandle -> showString "read-writeable"
469 instance Show Handle where
470 showsPrec p (Handle h) =
472 #if defined(__CONCURRENT_HASKELL__)
474 hdl_ = unsafePerformIO (primTakeMVar h)
476 -- (Big) SIGH: unfolded defn of takeMVar to avoid
477 -- an (oh-so) unfortunate module loop with PrelConc.
478 hdl_ = unsafePerformIO (IO $ \ s# ->
479 case h of { MVar h# ->
480 case takeMVar# h# s# of { (# s2# , r #) ->
484 hdl_ = unsafePerformIO (stToIO (readVar h))
488 showHdl (haType__ hdl_)
489 (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
490 showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
491 showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
493 showHdl :: Handle__Type -> ShowS -> ShowS
496 ClosedHandle -> showsPrec p ht . showString "}\n"
497 ErrorHandle _ -> showsPrec p ht . showString "}\n"
500 showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
503 NoBuffering -> showString "none"
504 LineBuffering -> showString "line"
505 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
506 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
509 def = unsafePerformIO (getBufSize fo)
511 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
512 mkBuffer__ fo sz_in_bytes = do
515 0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
517 chunk <- allocMemory__ sz_in_bytes
519 then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
521 setBuf fo chunk sz_in_bytes
525 %*********************************************************
527 \subsection[BufferMode]{Buffering modes}
529 %*********************************************************
531 Three kinds of buffering are supported: line-buffering,
532 block-buffering or no-buffering. These modes have the following
533 effects. For output, items are written out from the internal
534 buffer according to the buffer mode:
537 \item[line-buffering] the entire output buffer is written
538 out whenever a newline is output, the output buffer overflows,
539 a flush is issued, or the handle is closed.
541 \item[block-buffering] the entire output buffer is written out whenever
542 it overflows, a flush is issued, or the handle
545 \item[no-buffering] output is written immediately, and never stored
546 in the output buffer.
549 The output buffer is emptied as soon as it has been written out.
551 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
553 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
554 the next item is obtained from the buffer;
555 otherwise, when the input buffer is empty,
556 characters up to and including the next newline
557 character are read into the buffer. No characters
558 are available until the newline character is
560 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
561 the next block of data is read into this buffer.
562 \item[no-buffering] the next input item is read and returned.
565 For most implementations, physical files will normally be block-buffered
566 and terminals will normally be line-buffered. (the IO interface provides
567 operations for changing the default buffering of a handle tho.)
571 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
572 deriving (Eq, Ord, Show)
573 {- Read instance defined in IO. -}
577 Foreign import declarations to helper routines:
580 foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
581 foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
582 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
584 foreign import "libHS_cbits" "allocMemory__" unsafe
585 allocMemory__ :: Int -> IO Addr
586 foreign import "libHS_cbits" "getBufSize" unsafe
587 getBufSize :: FILE_OBJECT -> IO Int
588 foreign import "libHS_cbits" "setBuf" unsafe
589 setBuf :: FILE_OBJECT -> Addr -> Int -> IO ()