%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The AQUA Project, Glasgow University, 1994-1998
%
-
\section[IO]{Module @IO@}
+Implementation of the standard Haskell IO interface, see
+@http://haskell.org/onlinelibrary/io.html@ for the official
+definition.
+
\begin{code}
{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
module IO (
- Handle, HandlePosn,
+ Handle, -- abstract, instance of: Eq, Show.
+ HandlePosn(..), -- abstract, instance of: Eq, Show.
IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
BufferMode(NoBuffering,LineBuffering,BlockBuffering),
SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
- stdin, stdout, stderr,
-
- openFile, hClose,
- hFileSize, hIsEOF, isEOF,
- hSetBuffering, hGetBuffering, hFlush,
- hGetPosn, hSetPosn, hSeek,
- hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents,
- hPutChar, hPutStr, hPutStrLn, hPrint,
- hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
-
- isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
- isFullError, isEOFError,
- isIllegalOperation, isPermissionError, isUserError,
- ioeGetErrorString,
- ioeGetHandle, ioeGetFileName,
- try, bracket, bracket_
+ stdin, stdout, stderr, -- :: Handle
+
+ openFile, -- :: FilePath -> IOMode -> IO Handle
+ hClose, -- :: Handle -> IO ()
+ hFileSize, -- :: Handle -> IO Integer
+ hIsEOF, -- :: Handle -> IO Bool
+ isEOF, -- :: IO Bool
+
+ hSetBuffering, -- :: Handle -> BufferMode -> IO ()
+ hGetBuffering, -- :: Handle -> IO BufferMode
+ hFlush, -- :: Handle -> IO ()
+ hGetPosn, -- :: Handle -> IO HandlePosn
+ hSetPosn, -- :: Handle -> HandlePosn -> IO ()
+ hSeek, -- :: Handle -> SeekMode -> Integer -> IO ()
+ hWaitForInput, -- :: Handle -> Int -> IO Bool
+ hReady, -- :: Handle -> IO Bool
+ hGetChar, -- :: Handle -> IO Char
+ hGetLine, -- :: Handle -> IO [Char]
+ hLookAhead, -- :: Handle -> IO Char
+ hGetContents, -- :: Handle -> IO [Char]
+ hPutChar, -- :: Handle -> Char -> IO ()
+ hPutStr, -- :: Handle -> [Char] -> IO ()
+ hPutStrLn, -- :: Handle -> [Char] -> IO ()
+ hPrint, -- :: Show a => Handle -> a -> IO ()
+ hIsOpen, hIsClosed, -- :: Handle -> IO Bool
+ hIsReadable, hIsWritable, -- :: Handle -> IO Bool
+ hIsSeekable, -- :: Handle -> IO Bool
+
+ isAlreadyExistsError, isDoesNotExistError, -- :: IOError -> Bool
+ isAlreadyInUseError, isFullError,
+ isEOFError, isIllegalOperation,
+ isPermissionError, isUserError,
+
+ ioeGetErrorString, -- :: IOError -> String
+ ioeGetHandle, -- :: IOError -> Maybe Handle
+ ioeGetFileName, -- :: IOError -> Maybe FilePath
+
+ try, -- :: IO a -> IO (Either IOError a)
+ bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
+ bracket_, -- :: IO a -> (a -> IO b) -> IO c -> IO c
+
+ -- Non-standard extension (but will hopefully become standard with 1.5) is
+ -- to export the Prelude io functions via IO (in addition to exporting them
+ -- from the prelude...for now.)
+ IO,
+ FilePath, -- :: String
+ IOError,
+ ioError, -- :: IOError -> IO a
+ userError, -- :: String -> IOError
+ catch, -- :: IO a -> (IOError -> IO a) -> IO a
+ interact, -- :: (String -> String) -> IO ()
+
+ putChar, -- :: Char -> IO ()
+ putStr, -- :: String -> IO ()
+ putStrLn, -- :: String -> IO ()
+ print, -- :: Show a => a -> IO ()
+ getChar, -- :: IO Char
+ getLine, -- :: IO String
+ getContents, -- :: IO String
+ readFile, -- :: FilePath -> IO String
+ writeFile, -- :: FilePath -> String -> IO ()
+ appendFile, -- :: FilePath -> String -> IO ()
+ readIO, -- :: Read a => String -> IO a
+ readLn, -- :: Read a => IO a
+
) where
-import PrelST
+#ifdef __HUGS__
+import Ix(Ix)
+import PrelPrim ( IORef
+ , unsafePerformIO
+ , prelCleanupAfterRunAction
+ , copy_String_to_cstring
+ , primIntToChar
+ , primWriteCharOffAddr
+ , nullAddr
+ , newIORef
+ , writeIORef
+ , readIORef
+ , nh_close
+ , nh_errno
+ , nh_stdin
+ , nh_stdout
+ , nh_stderr
+ , nh_flush
+ , nh_open
+ , nh_free
+ , nh_read
+ , nh_write
+ , nh_filesize
+ , nh_iseof
+ )
+#else
+--import PrelST
+import PrelBase
+
import PrelIOBase
-import PrelArr ( MutableByteArray(..), newCharArray )
import PrelHandle -- much of the real stuff is in here
-import PrelPack ( unpackNBytesST )
-import PrelBase
-import PrelRead ( readParen, Read(..), reads, lex )
-import PrelMaybe
-import PrelEither
-import PrelAddr
-import PrelGHC
+
+import PrelRead ( readParen, Read(..), reads, lex,
+ readIO
+ )
+import PrelShow
+import PrelMaybe ( Either(..), Maybe(..) )
+import PrelAddr ( Addr(..), nullAddr )
+import PrelByteArr ( ByteArray )
+import PrelPack ( unpackNBytesAccST )
+import PrelException ( ioError, catch )
+import PrelConc
#ifndef __PARALLEL_HASKELL__
-import PrelForeign ( ForeignObj, makeForeignObj, writeForeignObj )
+import PrelForeign ( ForeignObj )
#endif
-import Ix
import Char ( ord, chr )
-\end{code}
-
-%*********************************************************
-%* *
-\subsection{Signatures}
-%* *
-%*********************************************************
-
-\begin{code}
---IOHandle:hClose :: Handle -> IO ()
---IOHandle:hFileSize :: Handle -> IO Integer
---IOHandle:hFlush :: Handle -> IO ()
---IOHandle:hGetBuffering :: Handle -> IO BufferMode
-hGetChar :: Handle -> IO Char
-hGetContents :: Handle -> IO String
---IOHandle:hGetPosn :: Handle -> IO HandlePosn
---IOHandle:hIsClosed :: Handle -> IO Bool
---IOHandle:hIsEOF :: Handle -> IO Bool
---IOHandle:hIsOpen :: Handle -> IO Bool
---IOHandle:hIsReadable :: Handle -> IO Bool
---IOHandle:hIsSeekable :: Handle -> IO Bool
---IOHandle:hIsWritable :: Handle -> IO Bool
-hLookAhead :: Handle -> IO Char
-hPrint :: Show a => Handle -> a -> IO ()
-hPutChar :: Handle -> Char -> IO ()
-hPutStr :: Handle -> String -> IO ()
-hPutStrLn :: Handle -> String -> IO ()
-hReady :: Handle -> IO Bool
-hWaitForInput :: Handle -> Int -> IO Bool
-
---IOHandle:hSeek :: Handle -> SeekMode -> Integer -> IO ()
---IOHandle:hSetBuffering :: Handle -> BufferMode -> IO ()
---IOHandle:hSetPosn :: HandlePosn -> IO ()
--- ioeGetFileName :: IOError -> Maybe FilePath
--- ioeGetErrorString :: IOError -> String
--- ioeGetHandle :: IOError -> Maybe Handle
--- isAlreadyExistsError :: IOError -> Bool
--- isAlreadyInUseError :: IOError -> Bool
---IOHandle:isEOF :: IO Bool
--- isEOFError :: IOError -> Bool
--- isFullError :: IOError -> Bool
--- isIllegalOperation :: IOError -> Bool
--- isPermissionError :: IOError -> Bool
--- isUserError :: IOError -> Bool
---IOHandle:openFile :: FilePath -> IOMode -> IO Handle
---IOHandle:stdin, stdout, stderr :: Handle
-\end{code}
-
-Standard instances for @Handle@:
-
-\begin{code}
-instance Eq IOError where
- (IOError h1 e1 str1) == (IOError h2 e2 str2) =
- e1==e2 && str1==str2 && h1==h2
-
-#ifndef __CONCURRENT_HASKELL__
-
-instance Eq Handle where
- (Handle h1) == (Handle h2) = h1 == h2
-
-#else
-
-{- OLD equality instance. The simpler one above
- seems more accurate! This one is still used for concurrent haskell,
- since there's no equality instance over MVars.
--}
-
-instance Eq Handle where
- h1 == h2 =
- unsafePerformIO (do
- h1_ <- readHandle h1
- writeHandle h1 h1_
- h2_<- readHandle h2
- writeHandle h2 h2_
- return (
- case (h1_,h2_) of
- (ErrorHandle (IOError h1 _ _), ErrorHandle (IOError h2 _ _)) -> h1 == h2
- (ClosedHandle, ClosedHandle) -> True
- (SemiClosedHandle v1 _, SemiClosedHandle v2 _) -> v1 == v2
- (ReadHandle v1 _ _ , ReadHandle v2 _ _) -> v1 == v2
- (WriteHandle v1 _ _ , WriteHandle v2 _ _) -> v1 == v2
- (AppendHandle v1 _ _ , AppendHandle v2 _ _) -> v1 == v2
- (ReadWriteHandle v1 _ _ , ReadWriteHandle v2 _ _) -> v1 == v2
- _ -> False))
-
-#endif
-
-instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
-
---Type declared in IOHandle, instance here because it depends on Eq.Handle
-instance Eq HandlePosn where
- (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
-
--- Type declared in IOBase, instance here because it
--- depends on PrelRead.(Read Maybe) instance.
-instance Read BufferMode where
- readsPrec p =
- readParen False
- (\r -> let lr = lex r
- in
- [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
- [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
- [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
- (mb, rest2) <- reads rest1])
+#endif /* ndef __HUGS__ */
\end{code}
+#ifndef __HUGS__
%*********************************************************
%* *
\subsection{Simple input operations}
@hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
before deciding whether the Handle has run dry or not.
+If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
+If not, it tries to read from the underlying OS handle. Notice that
+for buffered Handles connected to terminals this means waiting until a complete
+line is available.
+
\begin{code}
---hReady :: Handle -> IO Bool
+hReady :: Handle -> IO Bool
hReady h = hWaitForInput h 0
---hWaitForInput :: Handle -> Int -> IO Bool
-hWaitForInput handle msecs = do
- hdl <- wantReadableHandle handle
- rc <- _ccall_ inputReady (filePtr hdl) msecs
- writeHandle handle (markHandle hdl)
- case rc of
+hWaitForInput :: Handle -> Int -> IO Bool
+hWaitForInput handle msecs =
+ wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
+ rc <- inputReady (haFO__ handle_) (msecs::Int) -- ConcHask: SAFE, won't block
+ case (rc::Int) of
0 -> return False
1 -> return True
_ -> constructErrorAndFail "hWaitForInput"
\end{code}
-Computation $hGetChar hdl$ reads the next character from handle
-{\em hdl}, blocking until a character is available.
+@hGetChar hdl@ reads the next character from handle @hdl@,
+blocking until a character is available.
\begin{code}
---hGetChar :: Handle -> IO Char
-
+hGetChar :: Handle -> IO Char
hGetChar handle = do
- hdl <- wantReadableHandle handle
- intc <- _ccall_ fileGetc (filePtr hdl)
- writeHandle handle (markHandle hdl)
- if intc /= ``EOF''
- then return (chr intc)
- else constructErrorAndFail "hGetChar"
+ c <- mayBlockRead "hGetChar" handle fileGetc
+ return (chr c)
+{-
+ If EOF is reached before EOL is encountered, ignore the
+ EOF and return the partial line. Next attempt at calling
+ hGetLine on the handle will yield an EOF IO exception though.
+-}
hGetLine :: Handle -> IO String
hGetLine h = do
- c <- hGetChar h
- if c == '\n'
- then return ""
- else do
- s <- hGetLine h
- return (c:s)
+ c <- hGetChar h
+ if c == '\n' then
+ return ""
+ else do
+ l <- getRest
+ return (c:l)
+ where
+ getRest = do
+ c <-
+ catch
+ (hGetChar h)
+ (\ err -> do
+ if isEOFError err then
+ return '\n'
+ else
+ ioError err)
+ if c == '\n' then
+ return ""
+ else do
+ s <- getRest
+ return (c:s)
\end{code}
-Computation $hLookahead hdl$ returns the next character from handle
-{\em hdl} without removing it from the input buffer, blocking until a
+@hLookahead hdl@ returns the next character from handle @hdl@
+without removing it from the input buffer, blocking until a
character is available.
\begin{code}
---hLookAhead :: Handle -> IO Char
-
+hLookAhead :: Handle -> IO Char
hLookAhead handle = do
- hdl <- wantReadableHandle handle
- intc <- _ccall_ fileLookAhead (filePtr hdl)
- writeHandle handle (markHandle hdl)
- if intc /= ``EOF''
- then return (chr intc)
- else constructErrorAndFail "hLookAhead"
-
+ rc <- mayBlockRead "hLookAhead" handle fileLookAhead
+ return (chr rc)
\end{code}
%* *
%*********************************************************
-Computation $hGetContents hdl$ returns the list of characters
-corresponding to the unread portion of the channel or file managed by
-{\em hdl}, which is made semi-closed.
+@hGetContents hdl@ returns the list of characters corresponding
+to the unread portion of the channel or file managed by @hdl@,
+which is made semi-closed.
\begin{code}
---hGetContents :: Handle -> IO String
-
-hGetContents handle = do
- hdl_ <- wantReadableHandle handle
- {-
- To avoid introducing an extra layer of buffering here,
- we provide three lazy read methods, based on character,
- line, and block buffering.
- -}
- hdl_ <- getBufferMode hdl_
- case (bufferMode hdl_) of
- Just LineBuffering -> do
- buf_info <- allocBuf Nothing
- writeHandle handle (SemiClosedHandle (filePtr hdl_) buf_info)
- unsafeInterleaveIO (lazyReadLine handle)
- Just (BlockBuffering size) -> do
- buf_info <- allocBuf size
- writeHandle handle (SemiClosedHandle (filePtr hdl_) buf_info)
- unsafeInterleaveIO (lazyReadBlock handle)
- _ -> do -- Nothing is treated pessimistically as NoBuffering
- writeHandle handle (SemiClosedHandle (filePtr hdl_) (``NULL'', 0))
- unsafeInterleaveIO (lazyReadChar handle)
+hGetContents :: Handle -> IO String
+hGetContents handle =
+ -- can't use wantReadableHandle here, because we want to side effect
+ -- the handle.
+ withHandle handle $ \ handle_ -> do
+ case haType__ handle_ of
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hGetContents" handle
+ SemiClosedHandle -> ioe_closedHandle "hGetContents" handle
+ AppendHandle -> ioError not_readable_error
+ WriteHandle -> ioError not_readable_error
+ _ -> do
+ {-
+ To avoid introducing an extra layer of buffering here,
+ we provide three lazy read methods, based on character,
+ line, and block buffering.
+ -}
+ let handle_' = handle_{ haType__ = SemiClosedHandle }
+ case (haBufferMode__ handle_) of
+ LineBuffering -> do
+ str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
+ return (handle_', str)
+ BlockBuffering _ -> do
+ str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
+ return (handle_', str)
+ NoBuffering -> do
+ str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
+ return (handle_', str)
where
- allocBuf :: Maybe Int -> IO (Addr, Int)
- allocBuf msize = do
- buf <- _ccall_ malloc size
- if buf /= ``NULL''
- then return (buf, size)
- else fail (IOError Nothing ResourceExhausted "not enough virtual memory")
- where
- size =
- case msize of
- Just x -> x
- Nothing -> ``BUFSIZ''
+ not_readable_error =
+ IOError (Just handle) IllegalOperation "hGetContents"
+ ("handle is not open for reading")
\end{code}
-Note that someone may yank our handle out from under us, and then re-use
-the same FILE * for something else. Therefore, we have to re-examine the
-handle every time through.
+Note that someone may close the semi-closed handle (or change its buffering),
+so each these lazy read functions are pulled on, they have to check whether
+the handle has indeed been closed.
\begin{code}
-lazyReadBlock :: Handle -> IO String
-lazyReadLine :: Handle -> IO String
-lazyReadChar :: Handle -> IO String
-
-lazyReadBlock handle = do
- htype <- readHandle handle
- case htype of
- -- There cannae be an ErrorHandle here
- ClosedHandle -> do
- writeHandle handle htype
- return ""
- SemiClosedHandle fp (buf, size) -> do
- bytes <- _ccall_ readBlock buf fp size
- some <- (if bytes <= 0
- then return ""
- else stToIO (unpackNBytesST buf bytes))
- if bytes < 0
- then do
- _ccall_ free buf
- _ccall_ closeFile fp
#ifndef __PARALLEL_HASKELL__
- writeForeignObj fp ``NULL''
- writeHandle handle (SemiClosedHandle fp (``NULL'', 0))
+lazyReadBlock :: Handle -> ForeignObj -> IO String
+lazyReadLine :: Handle -> ForeignObj -> IO String
+lazyReadChar :: Handle -> ForeignObj -> IO String
#else
- writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))
+lazyReadBlock :: Handle -> Addr -> IO String
+lazyReadLine :: Handle -> Addr -> IO String
+lazyReadChar :: Handle -> Addr -> IO String
#endif
- return some
- else do
- writeHandle handle htype
- more <- unsafeInterleaveIO (lazyReadBlock handle)
- return (some ++ more)
-
-lazyReadLine handle = do
- htype <- readHandle handle
- case htype of
- -- There cannae be an ErrorHandle here
- ClosedHandle -> do
- writeHandle handle htype
- return ""
- SemiClosedHandle fp (buf, size) -> do
- bytes <- _ccall_ readLine buf fp size
- some <- (if bytes <= 0
- then return ""
- else stToIO (unpackNBytesST buf bytes))
- if bytes < 0
- then do
- _ccall_ free buf
- _ccall_ closeFile fp
-#ifndef __PARALLEL_HASKELL__
- writeForeignObj fp ``NULL''
- writeHandle handle (SemiClosedHandle fp (``NULL'', 0))
-#else
- writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))
-#endif
- return some
- else do
- writeHandle handle htype
- more <- unsafeInterleaveIO (lazyReadLine handle)
- return (some ++ more)
-
-lazyReadChar handle = do
- htype <- readHandle handle
- case htype of
- -- There cannae be an ErrorHandle here
- ClosedHandle -> do
- writeHandle handle htype
- return ""
- SemiClosedHandle fp buf_info -> do
- char <- _ccall_ readChar fp
- if char == ``EOF''
- then do
- _ccall_ closeFile fp
-#ifndef __PARALLEL_HASKELL__
- writeForeignObj fp ``NULL''
- writeHandle handle (SemiClosedHandle fp (``NULL'', 0))
-#else
- writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))
-#endif
- return ""
- else do
- writeHandle handle htype
- more <- unsafeInterleaveIO (lazyReadChar handle)
- return (chr char : more)
+
+lazyReadBlock handle fo = do
+ buf <- getBufStart fo 0
+ bytes <- mayBlock fo (readBlock fo) -- ConcHask: UNSAFE, may block.
+ case (bytes::Int) of
+ -3 -> -- buffering has been turned off, use lazyReadChar instead
+ lazyReadChar handle fo
+ -2 -> return ""
+ -1 -> -- an error occurred, close the handle
+ withHandle handle $ \ handle_ -> do
+ closeFile (haFO__ handle_) 0{-don't bother flushing-} -- ConcHask: SAFE, won't block.
+ return (handle_ { haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
+ _ -> do
+ more <- unsafeInterleaveIO (lazyReadBlock handle fo)
+ stToIO (unpackNBytesAccST buf bytes more)
+
+lazyReadLine handle fo = do
+ bytes <- mayBlock fo (readLine fo) -- ConcHask: UNSAFE, may block.
+ case (bytes::Int) of
+ -3 -> -- buffering has been turned off, use lazyReadChar instead
+ lazyReadChar handle fo
+ -2 -> return "" -- handle closed by someone else, stop reading.
+ -1 -> -- an error occurred, close the handle
+ withHandle handle $ \ handle_ -> do
+ closeFile (haFO__ handle_) 0{- don't bother flushing-} -- ConcHask: SAFE, won't block
+ return (handle_ { haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
+ _ -> do
+ more <- unsafeInterleaveIO (lazyReadLine handle fo)
+ buf <- getBufStart fo bytes -- ConcHask: won't block
+ stToIO (unpackNBytesAccST buf bytes more)
+
+lazyReadChar handle fo = do
+ char <- mayBlock fo (readChar fo) -- ConcHask: UNSAFE, may block.
+ case (char::Int) of
+ -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
+ lazyReadBlock handle fo
+
+ -3 -> -- buffering is now line-buffered, use lazyReadLine instead
+ lazyReadLine handle fo
+ -2 -> return ""
+ -1 -> -- error, silently close handle.
+ withHandle handle $ \ handle_ -> do
+ closeFile (haFO__ handle_) 0{-don't bother flusing-} -- ConcHask: SAFE, won't block
+ return (handle_{ haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
+ _ -> do
+ more <- unsafeInterleaveIO (lazyReadChar handle fo)
+ return (chr char : more)
\end{code}
%* *
%*********************************************************
-Computation $hPutChar hdl c$ writes the character {\em c} to the file
-or channel managed by {\em hdl}. Characters may be buffered if
-buffering is enabled for {\em hdl}.
+@hPutChar hdl ch@ writes the character @ch@ to the file
+or channel managed by @hdl@. Characters may be buffered if
+buffering is enabled for @hdl@
\begin{code}
---hPutChar :: Handle -> Char -> IO ()
-
-hPutChar handle c = do
- hdl <- wantWriteableHandle handle
- rc <- _ccall_ filePutc (filePtr hdl) (ord c)
- writeHandle handle (markHandle hdl)
+hPutChar :: Handle -> Char -> IO ()
+hPutChar handle c =
+ wantWriteableHandle "hPutChar" handle $ \ handle_ -> do
+ let fo = haFO__ handle_
+ flushConnectedBuf fo
+ rc <- mayBlock fo (filePutc fo c) -- ConcHask: UNSAFE, may block.
if rc == 0
then return ()
else constructErrorAndFail "hPutChar"
+
+\end{code}
+
+@hPutStr hdl s@ writes the string @s@ to the file or
+channel managed by @hdl@, buffering the output if needs be.
+
+\begin{code}
+hPutStr :: Handle -> String -> IO ()
+hPutStr handle str =
+ wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
+ let fo = haFO__ handle_
+ flushConnectedBuf fo
+ case haBufferMode__ handle_ of
+ LineBuffering -> do
+ buf <- getWriteableBuf fo
+ pos <- getBufWPtr fo
+ bsz <- getBufSize fo
+ writeLines fo buf bsz pos str
+ BlockBuffering _ -> do
+ buf <- getWriteableBuf fo
+ pos <- getBufWPtr fo
+ bsz <- getBufSize fo
+ writeBlocks fo buf bsz pos str
+ NoBuffering -> do
+ writeChars fo str
\end{code}
-Computation $hPutStr hdl s$ writes the string {\em s} to the file or
-channel managed by {\em hdl}.
+Going across the border between Haskell and C is relatively costly,
+so for block writes we pack the character strings on the Haskell-side
+before passing the external write routine a pointer to the buffer.
\begin{code}
---hPutStr :: Handle -> String -> IO ()
-
-hPutStr handle str = do
- hdl <- wantWriteableHandle handle
- {-
- The code below is not correct for line-buffered terminal streams,
- as the output stream is not flushed when terminal input is requested
- again, just upon seeing a newline character. A temporary fix for the
- most common line-buffered output stream, stdout, is to assume the
- buffering it was given when created (no buffering). This is not
- as bad as it looks, since stdio buffering sits underneath this.
-
- ToDo: fix me
+#ifdef __HUGS__
+
+#ifdef __CONCURRENT_HASKELL__
+/* See comment in shoveString below for explanation */
+#warning delayed update of buffer disnae work with killThread
+#endif
+
+#ifndef __PARALLEL_HASKELL__
+writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
+#else
+writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
+#endif
+writeLines obj buf bufLen initPos s =
+ let
+ shoveString :: Int -> [Char] -> IO ()
+ shoveString n ls =
+ case ls of
+ [] ->
+ {-
+ At the end of a buffer write, update the buffer position
+ in the underlying file object, so that if the handle
+ is subsequently dropped by the program, the whole
+ buffer will be properly flushed.
+
+ There's one case where this delayed up-date of the buffer
+ position can go wrong: if a thread is killed, it might be
+ in the middle of filling up a buffer, with the result that
+ the partial buffer update is lost upon finalisation. Not
+ that killing of threads is supported at the moment.
+
-}
- hdl <- getBufferMode hdl
- success <-
- (case bufferMode hdl of
- Just LineBuffering ->
- writeChars (filePtr hdl) str
- --writeLines (filePtr hdl) str
- Just (BlockBuffering (Just size)) ->
- writeBlocks (filePtr hdl) size str
- Just (BlockBuffering Nothing) ->
- writeBlocks (filePtr hdl) (``BUFSIZ''-1) str
- _ -> -- Nothing is treated pessimistically as NoBuffering
- writeChars (filePtr hdl) str
- )
- writeHandle handle (markHandle hdl)
- if success
- then return ()
- else constructErrorAndFail "hPutStr"
+ setBufWPtr obj n
+ (x:xs) -> do
+ primWriteCharOffAddr buf n x
+ {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
+ if n == bufLen || x == '\n'
+ then do
+ rc <- mayBlock obj (writeFileObject obj (n + 1)) -- ConcHask: UNSAFE, may block.
+ if rc == 0
+ then shoveString 0 xs
+ else constructErrorAndFail "writeLines"
+ else
+ shoveString (n + 1) xs
+ in
+ shoveString initPos s
+#else /* ndef __HUGS__ */
#ifndef __PARALLEL_HASKELL__
-writeLines :: ForeignObj -> String -> IO Bool
+writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
#else
-writeLines :: Addr -> String -> IO Bool
+writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
#endif
-writeLines = writeChunks (``BUFSIZ''-1) True
+writeLines obj buf (I# bufLen) (I# initPos#) s =
+ let
+ write_char :: Addr -> Int# -> Char# -> IO ()
+ write_char (A# buf#) n# c# =
+ IO $ \ s# ->
+ case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
+ shoveString :: Int# -> [Char] -> IO ()
+ shoveString n ls =
+ case ls of
+ [] ->
+ {-
+ At the end of a buffer write, update the buffer position
+ in the underlying file object, so that if the handle
+ is subsequently dropped by the program, the whole
+ buffer will be properly flushed.
+
+ There's one case where this delayed up-date of the buffer
+ position can go wrong: if a thread is killed, it might be
+ in the middle of filling up a buffer, with the result that
+ the partial buffer update is lost upon finalisation. Not
+ that killing of threads is supported at the moment.
+
+ -}
+ setBufWPtr obj (I# n)
+
+ ((C# x):xs) -> do
+ write_char buf n x
+ {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
+ if n ==# bufLen || x `eqChar#` '\n'#
+ then do
+ rc <- mayBlock obj (writeFileObject obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block.
+ if rc == 0
+ then shoveString 0# xs
+ else constructErrorAndFail "writeLines"
+ else
+ shoveString (n +# 1#) xs
+ in
+ shoveString initPos# s
+#endif /* ndef __HUGS__ */
+
+#ifdef __HUGS__
#ifndef __PARALLEL_HASKELL__
-writeBlocks :: ForeignObj -> Int -> String -> IO Bool
+writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
#else
-writeBlocks :: Addr -> Int -> String -> IO Bool
+writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
#endif
-writeBlocks fp size s = writeChunks size False fp s
-
- {-
- The breaking up of output into lines along \n boundaries
- works fine as long as there are newlines to split by.
- Avoid the splitting up into lines alltogether (doesn't work
- for overly long lines like the stuff that showsPrec instances
- normally return). Instead, we split them up into fixed size
- chunks before blasting them off to the Real World.
-
- Hacked to avoid multiple passes over the strings - unsightly, but
- a whole lot quicker. -- SOF 3/96
- -}
+writeBlocks obj buf bufLen initPos s =
+ let
+ shoveString :: Int -> [Char] -> IO ()
+ shoveString n ls =
+ case ls of
+ [] ->
+ {-
+ At the end of a buffer write, update the buffer position
+ in the underlying file object, so that if the handle
+ is subsequently dropped by the program, the whole
+ buffer will be properly flushed.
+
+ There's one case where this delayed up-date of the buffer
+ position can go wrong: if a thread is killed, it might be
+ in the middle of filling up a buffer, with the result that
+ the partial buffer update is lost upon finalisation. However,
+ by the time killThread is supported, Haskell finalisers are also
+ likely to be in, which means the 'IOFileObject' hack can go
+ alltogether.
+
+ -}
+ setBufWPtr obj n
+ (x:xs) -> do
+ primWriteCharOffAddr buf n x
+ if n == bufLen
+ then do
+ rc <- mayBlock obj (writeFileObject obj (n + 1)) -- ConcHask: UNSAFE, may block.
+ if rc == 0
+ then shoveString 0 xs
+ else constructErrorAndFail "writeChunks"
+ else
+ shoveString (n + 1) xs
+ in
+ shoveString initPos s
+#else /* ndef __HUGS__ */
#ifndef __PARALLEL_HASKELL__
-writeChunks :: Int -> Bool -> ForeignObj -> String -> IO Bool
+writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
#else
-writeChunks :: Int -> Bool -> Addr -> String -> IO Bool
+writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
#endif
-writeChunks (I# bufLen) chopOnNewLine fp s =
- stToIO (newCharArray (0,I# bufLen)) >>= \ arr@(MutableByteArray _ arr#) ->
+writeBlocks obj buf (I# bufLen) (I# initPos#) s =
let
- write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> IO ()
- write_char arr# n x = IO $ \ s# ->
- case (writeCharArray# arr# n x s#) of { s1# ->
- IOok s1# () }
+ write_char :: Addr -> Int# -> Char# -> IO ()
+ write_char (A# buf#) n# c# =
+ IO $ \ s# ->
+ case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
- shoveString :: Int# -> [Char] -> IO Bool
+ shoveString :: Int# -> [Char] -> IO ()
shoveString n ls =
case ls of
[] ->
- if n ==# 0# then
- return True
- else do
- rc <- _ccall_ writeFile arr fp (I# n)
- return (rc==0)
+ {-
+ At the end of a buffer write, update the buffer position
+ in the underlying file object, so that if the handle
+ is subsequently dropped by the program, the whole
+ buffer will be properly flushed.
+
+ There's one case where this delayed up-date of the buffer
+ position can go wrong: if a thread is killed, it might be
+ in the middle of filling up a buffer, with the result that
+ the partial buffer update is lost upon finalisation. However,
+ by the time killThread is supported, Haskell finalisers are also
+ likely to be in, which means the 'IOFileObject' hack can go
+ alltogether.
+
+ -}
+ setBufWPtr obj (I# n)
((C# x):xs) -> do
- write_char arr# n x
-
- {- Flushing lines - should we bother? Yes, for line-buffered output. -}
- if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#))
+ write_char buf n x
+ if n ==# bufLen
then do
- rc <- _ccall_ writeFile arr fp (I# (n +# 1#))
+ rc <- mayBlock obj (writeFileObject obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block.
if rc == 0
then shoveString 0# xs
- else return False
+ else constructErrorAndFail "writeChunks"
else
shoveString (n +# 1#) xs
in
- shoveString 0# s
+ shoveString initPos# s
+#endif /* ndef __HUGS__ */
#ifndef __PARALLEL_HASKELL__
-writeChars :: ForeignObj -> String -> IO Bool
+writeChars :: ForeignObj -> String -> IO ()
#else
-writeChars :: Addr -> String -> IO Bool
+writeChars :: Addr -> String -> IO ()
#endif
-writeChars fp "" = return True
-writeChars fp (c:cs) = do
- rc <- _ccall_ filePutc fp (ord c)
+writeChars _fo "" = return ()
+writeChars fo (c:cs) = do
+ rc <- mayBlock fo (filePutc fo c) -- ConcHask: UNSAFE, may block.
if rc == 0
- then writeChars fp cs
- else return False
+ then writeChars fo cs
+ else constructErrorAndFail "writeChars"
\end{code}
-The @hPutBuf hdl len elt_sz buf@ action writes the buffer @buf@ to
-the file/channel managed by @hdl@
-the string {\em s} to the file or
-channel managed by {\em hdl}.
-
-begin{code}
-hPutBuf :: Handle -> Int -> Int -> ByteArray Int -> IO ()
-hPutBuf handle len el_sz buf = do
- hdl <- wantWriteableHandle handle
- {-
- The code below is not correct for line-buffered terminal streams,
- as the output stream is not flushed when terminal input is requested
- again, just upon seeing a newline character. A temporary fix for the
- most common line-buffered output stream, stdout, is to assume the
- buffering it was given when created (no buffering). This is not
- as bad as it looks, since stdio buffering sits underneath this.
-
- ToDo: fix me
- -}
- hdl <- getBufferMode hdl
- success <-
- (case bufferMode hdl of
- Just LineBuffering ->
- writeChars (filePtr hdl) str
- --writeLines (filePtr hdl) str
- Just (BlockBuffering (Just size)) ->
- writeBlocks (filePtr hdl) size str
- Just (BlockBuffering Nothing) ->
- writeBlocks (filePtr hdl) ``BUFSIZ'' str
- _ -> -- Nothing is treated pessimistically as NoBuffering
- writeChars (filePtr hdl) str)
- writeHandle handle (markHandle hdl)
- if success
- then return ()
- else constructErrorAndFail "hPutBuf"
-
-end{code}
-
-Computation $hPrint hdl t$ writes the string representation of {\em t}
-given by the $shows$ function to the file or channel managed by {\em
+Computation @hPrint hdl t@ writes the string representation of {\em t}
+given by the @shows@ function to the file or channel managed by {\em
hdl}.
-SOF 2/97: Seem to have disappeared in 1.4 libs.
+[ Seem to have disappeared from the 1.4 interface - SOF 2/97 ]
\begin{code}
---hPrint :: Show a => Handle -> a -> IO ()
-hPrint hdl = hPutStr hdl . show
+hPrint :: Show a => Handle -> a -> IO ()
+hPrint hdl = hPutStrLn hdl . show
\end{code}
Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
the handle \tr{hdl}, adding a newline at the end.
\begin{code}
---hPutStrLn :: Handle -> String -> IO ()
+hPutStrLn :: Handle -> String -> IO ()
hPutStrLn hndl str = do
hPutStr hndl str
hPutChar hndl '\n'
%* *
%*********************************************************
-The construct $try comp$ exposes errors which occur within a
+The construct @try comp@ exposes errors which occur within a
computation, and which are not fully handled. It always succeeds.
\begin{code}
after x
case rs of
Right r -> return r
- Left e -> fail e
+ Left e -> ioError e
+
+-- variant of the above where middle computation doesn't want x
+bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
+bracket_ before after m = do
+ x <- before
+ rs <- try m
+ after x
+ case rs of
+ Right r -> return r
+ Left e -> ioError e
+\end{code}
+
+
+
+%*********************************************************
+%* *
+\subsection{The HUGS version of IO
+%* *
+%*********************************************************
+
+#else /* __HUGS__ */
+
+\begin{code}
+import Ix(Ix)
+import Monad(when)
+
+unimp :: String -> a
+unimp s = error ("IO library: function not implemented: " ++ s)
+
+type FILE_STAR = Addr
+type Ptr = Addr
+nULL = nullAddr
+
+data Handle
+ = Handle { name :: FilePath,
+ file :: FILE_STAR, -- C handle
+ mut :: IORef Handle_Mut, -- open/closed/semiclosed
+ mode :: IOMode,
+ seekable :: Bool
+ }
+
+data Handle_Mut
+ = Handle_Mut { state :: HState
+ }
+ deriving Show
+
+set_state :: Handle -> HState -> IO ()
+set_state hdl new_state
+ = writeIORef (mut hdl) (Handle_Mut { state = new_state })
+get_state :: Handle -> IO HState
+get_state hdl
+ = readIORef (mut hdl) >>= \m -> return (state m)
+
+mkErr :: Handle -> String -> IO a
+mkErr h msg
+ = do mut <- readIORef (mut h)
+ when (state mut /= HClosed)
+ (nh_close (file h) >> set_state h HClosed)
+ dummy <- nh_errno
+ ioError (IOError msg)
+
+stdin
+ = Handle {
+ name = "stdin",
+ file = unsafePerformIO nh_stdin,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
+ mode = ReadMode
+ }
+
+stdout
+ = Handle {
+ name = "stdout",
+ file = unsafePerformIO nh_stdout,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
+ mode = WriteMode
+ }
+
+stderr
+ = Handle {
+ name = "stderr",
+ file = unsafePerformIO nh_stderr,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
+ mode = WriteMode
+ }
+
+
+instance Eq Handle where
+ h1 == h2 = file h1 == file h2
+
+instance Show Handle where
+ showsPrec _ h = showString ("`" ++ name h ++ "'")
+
+data HandlePosn
+ = HandlePosn
+ deriving (Eq, Show)
+
+
+data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
+ deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
+
+data BufferMode = NoBuffering | LineBuffering
+ | BlockBuffering (Maybe Int)
+ deriving (Eq, Ord, Read, Show)
+
+data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
+ deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
+
+data HState = HOpen | HSemiClosed | HClosed
+ deriving (Show, Eq)
+
+
+-- A global variable holding a list of all open handles.
+-- Each handle is present as many times as it has been opened.
+-- Any given file is allowed to have _either_ one writeable handle
+-- or many readable handles in this list. The list is used to
+-- enforce single-writer multiple reader semantics. It also
+-- provides a list of handles for System.exitWith to flush and
+-- close. In order not to have to put all this stuff in the
+-- Prelude, System.exitWith merely runs prelExitWithAction,
+-- which is originally Nothing, but which we set to Just ...
+-- once handles appear in the list.
+
+allHandles :: IORef [Handle]
+allHandles = unsafePerformIO (newIORef [])
+
+elemWriterHandles :: FilePath -> IO Bool
+elemAllHandles :: FilePath -> IO Bool
+addHandle :: Handle -> IO ()
+delHandle :: Handle -> IO ()
+cleanupHandles :: IO ()
+
+cleanupHandles
+ = do hdls <- readIORef allHandles
+ mapM_ cleanupHandle hdls
+ where
+ cleanupHandle h
+ | mode h == ReadMode
+ = nh_close (file h)
+ >> nh_errno >>= \_ -> return ()
+ | otherwise
+ = nh_flush (file h) >> nh_close (file h)
+ >> nh_errno >>= \_ -> return ()
+
+elemWriterHandles fname
+ = do hdls <- readIORef allHandles
+ let hdls_w = filter ((/= ReadMode).mode) hdls
+ return (fname `elem` (map name hdls_w))
+
+elemAllHandles fname
+ = do hdls <- readIORef allHandles
+ return (fname `elem` (map name hdls))
+
+addHandle hdl
+ = do cleanup_action <- readIORef prelCleanupAfterRunAction
+ case cleanup_action of
+ Nothing
+ -> writeIORef prelCleanupAfterRunAction (Just cleanupHandles)
+ Just xx
+ -> return ()
+ hdls <- readIORef allHandles
+ writeIORef allHandles (hdl : hdls)
+
+delHandle hdl
+ = do hdls <- readIORef allHandles
+ let hdls' = takeWhile (/= hdl) hdls
+ ++ drop 1 (dropWhile (/= hdl) hdls)
+ writeIORef allHandles hdls'
+
+
+
+openFile :: FilePath -> IOMode -> IO Handle
+openFile f mode
+
+ | null f
+ = (ioError.IOError) "openFile: empty file name"
+
+ | mode == ReadMode
+ = do not_ok <- elemWriterHandles f
+ if not_ok
+ then (ioError.IOError)
+ ("openFile: `" ++ f ++ "' in " ++ show mode
+ ++ ": is already open for writing")
+ else openFile_main f mode
+
+ | mode /= ReadMode
+ = do not_ok <- elemAllHandles f
+ if not_ok
+ then (ioError.IOError)
+ ("openFile: `" ++ f ++ "' in " ++ show mode
+ ++ ": is already open for reading or writing")
+ else openFile_main f mode
+
+ | otherwise
+ = openFile_main f mode
+
+openFile_main f mode
+ = copy_String_to_cstring f >>= \nameptr ->
+ nh_open nameptr (mode2num mode) >>= \fh ->
+ nh_free nameptr >>
+ if fh == nULL
+ then (ioError.IOError)
+ ("openFile: can't open <<" ++ f ++ ">> in " ++ show mode)
+ else do r <- newIORef (Handle_Mut { state = HOpen })
+ let hdl = Handle { name = f, file = fh,
+ mut = r, mode = mode }
+ addHandle hdl
+ return hdl
+ where
+ mode2num :: IOMode -> Int
+ mode2num ReadMode = 0
+ mode2num WriteMode = 1
+ mode2num AppendMode = 2
+ mode2num ReadWriteMode
+ = error
+ ("openFile <<" ++ f ++ ">>: ReadWriteMode not supported")
+
+hClose :: Handle -> IO ()
+hClose h
+ = do mut <- readIORef (mut h)
+ if state mut == HClosed
+ then mkErr h
+ ("hClose on closed handle " ++ show h)
+ else
+ do set_state h HClosed
+ delHandle h
+ nh_close (file h)
+ err <- nh_errno
+ if err == 0
+ then return ()
+ else mkErr h
+ ("hClose: error closing " ++ name h)
+
+hGetContents :: Handle -> IO String
+hGetContents h
+ | mode h /= ReadMode
+ = mkErr h ("hGetContents on non-ReadMode handle " ++ show h)
+ | otherwise
+ = do mut <- readIORef (mut h)
+ if state mut /= HOpen
+ then mkErr h
+ ("hGetContents on closed/semiclosed handle " ++ show h)
+ else
+ do set_state h HSemiClosed
+ read_all (file h)
+ where
+ read_all f
+ = nh_read f >>= \ci ->
+ if ci == -1
+ then return []
+ else read_all f >>= \rest ->
+ return ((primIntToChar ci):rest)
+
+hPutStr :: Handle -> String -> IO ()
+hPutStr h s
+ | mode h == ReadMode
+ = mkErr h ("hPutStr on ReadMode handle " ++ show h)
+ | otherwise
+ = do mut <- readIORef (mut h)
+ if state mut /= HOpen
+ then mkErr h
+ ("hPutStr on closed/semiclosed handle " ++ show h)
+ else write_all (file h) s
+ where
+ write_all f []
+ = return ()
+ write_all f (c:cs)
+ = nh_write f c >> write_all f cs
+
+hFileSize :: Handle -> IO Integer
+hFileSize h
+ = do sz <- nh_filesize (file h)
+ er <- nh_errno
+ if er == 0
+ then return (fromIntegral sz)
+ else mkErr h ("hFileSize on " ++ show h)
+
+hIsEOF :: Handle -> IO Bool
+hIsEOF h
+ = do iseof <- nh_iseof (file h)
+ er <- nh_errno
+ if er == 0
+ then return (iseof /= 0)
+ else mkErr h ("hIsEOF on " ++ show h)
+
+isEOF :: IO Bool
+isEOF = hIsEOF stdin
+
+hSetBuffering :: Handle -> BufferMode -> IO ()
+hSetBuffering = unimp "IO.hSetBuffering"
+hGetBuffering :: Handle -> IO BufferMode
+hGetBuffering = unimp "IO.hGetBuffering"
+
+hFlush :: Handle -> IO ()
+hFlush h
+ = do mut <- readIORef (mut h)
+ if state mut /= HOpen
+ then mkErr h
+ ("hFlush on closed/semiclosed file " ++ name h)
+ else nh_flush (file h)
+
+hGetPosn :: Handle -> IO HandlePosn
+hGetPosn = unimp "IO.hGetPosn"
+hSetPosn :: HandlePosn -> IO ()
+hSetPosn = unimp "IO.hSetPosn"
+hSeek :: Handle -> SeekMode -> Integer -> IO ()
+hSeek = unimp "IO.hSeek"
+hWaitForInput :: Handle -> Int -> IO Bool
+hWaitForInput = unimp "hWaitForInput"
+hReady :: Handle -> IO Bool
+hReady h = unimp "hReady" -- hWaitForInput h 0
+
+hGetChar :: Handle -> IO Char
+hGetChar h
+ = nh_read (file h) >>= \ci ->
+ return (primIntToChar ci)
+
+hGetLine :: Handle -> IO String
+hGetLine h = do c <- hGetChar h
+ if c=='\n' then return ""
+ else do cs <- hGetLine h
+ return (c:cs)
+
+hLookAhead :: Handle -> IO Char
+hLookAhead = unimp "IO.hLookAhead"
+
+
+hPutChar :: Handle -> Char -> IO ()
+hPutChar h c = hPutStr h [c]
+
+hPutStrLn :: Handle -> String -> IO ()
+hPutStrLn h s = do { hPutStr h s; hPutChar h '\n' }
+
+hPrint :: Show a => Handle -> a -> IO ()
+hPrint h = hPutStrLn h . show
+
+hIsOpen, hIsClosed, hIsReadable, hIsWritable :: Handle -> IO Bool
+hIsOpen h = do { s <- get_state h; return (s == HOpen) }
+hIsClosed h = do { s <- get_state h; return (s == HClosed) }
+hIsReadable h = return (mode h == ReadMode)
+hIsWritable h = return (mode h `elem` [WriteMode, AppendMode])
+
+hIsSeekable :: Handle -> IO Bool
+hIsSeekable = unimp "IO.hIsSeekable"
+
+isIllegalOperation,
+ isAlreadyExistsError,
+ isDoesNotExistError,
+ isAlreadyInUseError,
+ isFullError,
+ isEOFError,
+ isPermissionError,
+ isUserError :: IOError -> Bool
+
+isIllegalOperation = unimp "IO.isIllegalOperation"
+isAlreadyExistsError = unimp "IO.isAlreadyExistsError"
+isDoesNotExistError = unimp "IO.isDoesNotExistError"
+isAlreadyInUseError = unimp "IO.isAlreadyInUseError"
+isFullError = unimp "IO.isFullError"
+isEOFError = unimp "IO.isEOFError"
+isPermissionError = unimp "IO.isPermissionError"
+isUserError = unimp "IO.isUserError"
+
+
+ioeGetErrorString :: IOError -> String
+ioeGetErrorString = unimp "IO.ioeGetErrorString"
+ioeGetHandle :: IOError -> Maybe Handle
+ioeGetHandle = unimp "IO.ioeGetHandle"
+ioeGetFileName :: IOError -> Maybe FilePath
+ioeGetFileName = unimp "IO.ioeGetFileName"
+
+try :: IO a -> IO (Either IOError a)
+try p = catch (p >>= (return . Right)) (return . Left)
+
+bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
+bracket before after m = do
+ x <- before
+ rs <- try (m x)
+ after x
+ case rs of
+ Right r -> return r
+ Left e -> ioError e
-- variant of the above where middle computation doesn't want x
bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
after x
case rs of
Right r -> return r
- Left e -> fail e
+ Left e -> ioError e
+
+-- TODO: Hugs/slurpFile
+slurpFile = unimp "IO.slurpFile"
\end{code}
+#endif /* #ifndef __HUGS__ */