X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FIO.lhs;h=1a8d4b338ca9cbadbe14ecb68e189f67791b7a4b;hb=e921b2e307532e0f30eefa88b11a124be592bde4;hp=b008e7203d4d4b68ae939f1b1a8a955dc268a09b;hpb=781a3b702d1112e72a2117fdbd5327e0e4fe271e;p=ghc-hetmet.git diff --git a/ghc/lib/std/IO.lhs b/ghc/lib/std/IO.lhs index b008e72..1a8d4b3 100644 --- a/ghc/lib/std/IO.lhs +++ b/ghc/lib/std/IO.lhs @@ -10,7 +10,6 @@ definition. \begin{code} {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-} -#ifndef BODY /* Hugs just includes this in PreludeBuiltin so no header needed */ module IO ( Handle, -- abstract, instance of: Eq, Show. HandlePosn(..), -- abstract, instance of: Eq, Show. @@ -84,9 +83,9 @@ module IO ( readIO, -- :: Read a => String -> IO a readLn, -- :: Read a => IO a +#ifndef __HUGS__ -- extensions hPutBuf, -#ifndef __HUGS__ hPutBufBA, #endif slurpFile @@ -94,11 +93,8 @@ module IO ( ) where #ifdef __HUGS__ - -import PreludeBuiltin - +import Ix(Ix) #else - --import PrelST import PrelBase @@ -109,9 +105,9 @@ import PrelRead ( readParen, Read(..), reads, lex, readIO ) import PrelShow -import PrelMaybe ( Either(..) ) +import PrelMaybe ( Either(..), Maybe(..) ) import PrelAddr ( Addr(..), nullAddr ) -import PrelArr ( ByteArray ) +import PrelByteArr ( ByteArray ) import PrelPack ( unpackNBytesAccST ) import PrelException ( ioError, catch ) @@ -122,53 +118,9 @@ import PrelForeign ( ForeignObj ) import Char ( ord, chr ) #endif /* ndef __HUGS__ */ -#endif /* ndef BODY */ - -#ifndef HEAD - -#ifdef __HUGS__ -#define cat2(x,y) x##y -#define CCALL(fun) cat2(prim_,fun) -#define __CONCURRENT_HASKELL__ -#define stToIO id -#define unpackNBytesAccST primUnpackCStringAcc -#else -#define CCALL(fun) _ccall_ fun -#define ref_freeStdFileObject (``&freeStdFileObject''::Addr) -#define ref_freeFileObject (``&freeFileObject''::Addr) -#define const_BUFSIZ ``BUFSIZ'' -#endif - -\end{code} - -Standard instances for @Handle@: - -\begin{code} -instance Eq IOError where - (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) = - e1==e2 && str1==str2 && h1==h2 && loc1 == loc2 - -instance Eq Handle where - (Handle h1) == (Handle h2) = h1 == h2 - ---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 _ = - 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]) - \end{code} +#ifndef __HUGS__ %********************************************************* %* * \subsection{Simple input operations} @@ -193,8 +145,7 @@ hReady h = hWaitForInput h 0 hWaitForInput :: Handle -> Int -> IO Bool hWaitForInput handle msecs = wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do - rc <- CCALL(inputReady) (haFO__ handle_) (msecs::Int) -- ConcHask: SAFE, won't block - writeHandle handle handle_ + rc <- inputReady (haFO__ handle_) (msecs::Int) -- ConcHask: SAFE, won't block case (rc::Int) of 0 -> return False 1 -> return True @@ -209,8 +160,7 @@ hGetChar :: Handle -> IO Char hGetChar handle = wantReadableHandle "hGetChar" handle $ \ handle_ -> do let fo = haFO__ handle_ - intc <- mayBlock fo (CCALL(fileGetc) fo) -- ConcHask: UNSAFE, may block - writeHandle handle handle_ + intc <- mayBlock fo (fileGetc fo) -- ConcHask: UNSAFE, may block if intc /= ((-1)::Int) then return (chr intc) else constructErrorAndFail "hGetChar" @@ -255,8 +205,7 @@ hLookAhead :: Handle -> IO Char hLookAhead handle = wantReadableHandle "hLookAhead" handle $ \ handle_ -> do let fo = haFO__ handle_ - intc <- mayBlock fo (CCALL(fileLookAhead) fo) -- ConcHask: UNSAFE, may block - writeHandle handle handle_ + intc <- mayBlock fo (fileLookAhead fo) -- ConcHask: UNSAFE, may block if intc /= (-1) then return (chr intc) else constructErrorAndFail "hLookAhead" @@ -277,18 +226,36 @@ which is made semi-closed. \begin{code} hGetContents :: Handle -> IO String hGetContents handle = - wantReadableHandle "hGetContents" handle $ \ handle_ -> do - {- - To avoid introducing an extra layer of buffering here, - we provide three lazy read methods, based on character, - line, and block buffering. - -} - writeHandle handle (handle_{ haType__ = SemiClosedHandle }) - case (haBufferMode__ handle_) of - LineBuffering -> unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_)) - BlockBuffering _ -> unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_)) - NoBuffering -> unsafeInterleaveIO (lazyReadChar handle (haFO__ 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 + not_readable_error = + IOError (Just handle) IllegalOperation "hGetContents" + ("handle is not open for reading") \end{code} Note that someone may close the semi-closed handle (or change its buffering), @@ -307,41 +274,41 @@ lazyReadChar :: Handle -> Addr -> IO String #endif lazyReadBlock handle fo = do - buf <- CCALL(getBufStart) fo (0::Int) - bytes <- mayBlock fo (CCALL(readBlock) fo) -- ConcHask: UNSAFE, may block. + 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 - CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flushing-} -- ConcHask: SAFE, won't block. - writeHandle handle (handle_ { haType__ = ClosedHandle, - haFO__ = nullFile__ }) - return "" + 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 (CCALL(readLine) fo) -- ConcHask: UNSAFE, may block. + 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 - CCALL(closeFile) (haFO__ handle_) (0::Int){- don't bother flushing-} -- ConcHask: SAFE, won't block - writeHandle handle (handle_ { haType__ = ClosedHandle, - haFO__ = nullFile__ }) - return "" + 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 <- CCALL(getBufStart) fo bytes -- ConcHask: won't block + buf <- getBufStart fo bytes -- ConcHask: won't block stToIO (unpackNBytesAccST buf bytes more) lazyReadChar handle fo = do - char <- mayBlock fo (CCALL(readChar) fo) -- ConcHask: UNSAFE, may block. + 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 @@ -351,10 +318,10 @@ lazyReadChar handle fo = do -2 -> return "" -1 -> -- error, silently close handle. withHandle handle $ \ handle_ -> do - CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flusing-} -- ConcHask: SAFE, won't block - writeHandle handle (handle_{ haType__ = ClosedHandle, - haFO__ = nullFile__ }) - return "" + 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) @@ -378,8 +345,7 @@ hPutChar handle c = wantWriteableHandle "hPutChar" handle $ \ handle_ -> do let fo = haFO__ handle_ flushConnectedBuf fo - rc <- mayBlock fo (CCALL(filePutc) fo c) -- ConcHask: UNSAFE, may block. - writeHandle handle handle_ + rc <- mayBlock fo (filePutc fo c) -- ConcHask: UNSAFE, may block. if rc == 0 then return () else constructErrorAndFail "hPutChar" @@ -397,19 +363,17 @@ hPutStr handle str = flushConnectedBuf fo case haBufferMode__ handle_ of LineBuffering -> do - buf <- CCALL(getWriteableBuf) fo - pos <- CCALL(getBufWPtr) fo - bsz <- CCALL(getBufSize) fo + buf <- getWriteableBuf fo + pos <- getBufWPtr fo + bsz <- getBufSize fo writeLines fo buf bsz pos str BlockBuffering _ -> do - buf <- CCALL(getWriteableBuf) fo - pos <- CCALL(getBufWPtr) fo - bsz <- CCALL(getBufSize) fo + buf <- getWriteableBuf fo + pos <- getBufWPtr fo + bsz <- getBufSize fo writeBlocks fo buf bsz pos str NoBuffering -> do writeChars fo str - writeHandle handle handle_ - \end{code} Going across the border between Haskell and C is relatively costly, @@ -435,9 +399,6 @@ writeLines obj buf bufLen initPos s = shoveString n ls = case ls of [] -> - if n == 0 then - CCALL(setBufWPtr) obj (0::Int) - else do {- At the end of a buffer write, update the buffer position in the underlying file object, so that if the handle @@ -451,14 +412,14 @@ writeLines obj buf bufLen initPos s = that killing of threads is supported at the moment. -} - CCALL(setBufWPtr) obj n + 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 (CCALL(writeFileObject) obj (n + 1)) -- ConcHask: UNSAFE, may block. + rc <- mayBlock obj (writeFileObject obj (n + 1)) -- ConcHask: UNSAFE, may block. if rc == 0 then shoveString 0 xs else constructErrorAndFail "writeLines" @@ -483,9 +444,6 @@ writeLines obj buf (I# bufLen) (I# initPos#) s = shoveString n ls = case ls of [] -> - if n ==# 0# then - CCALL(setBufWPtr) obj (0::Int) - else do {- At the end of a buffer write, update the buffer position in the underlying file object, so that if the handle @@ -499,14 +457,14 @@ writeLines obj buf (I# bufLen) (I# initPos#) s = that killing of threads is supported at the moment. -} - CCALL(setBufWPtr) obj (I# n) + 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 (CCALL(writeFileObject) obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block. + rc <- mayBlock obj (writeFileObject obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block. if rc == 0 then shoveString 0# xs else constructErrorAndFail "writeLines" @@ -528,9 +486,6 @@ writeBlocks obj buf bufLen initPos s = shoveString n ls = case ls of [] -> - if n == 0 then - CCALL(setBufWPtr) obj (0::Int) - else do {- At the end of a buffer write, update the buffer position in the underlying file object, so that if the handle @@ -546,13 +501,13 @@ writeBlocks obj buf bufLen initPos s = alltogether. -} - CCALL(setBufWPtr) obj n + setBufWPtr obj n (x:xs) -> do primWriteCharOffAddr buf n x if n == bufLen then do - rc <- mayBlock obj (CCALL(writeFileObject) obj (n + 1)) -- ConcHask: UNSAFE, may block. + rc <- mayBlock obj (writeFileObject obj (n + 1)) -- ConcHask: UNSAFE, may block. if rc == 0 then shoveString 0 xs else constructErrorAndFail "writeChunks" @@ -577,9 +532,6 @@ writeBlocks obj buf (I# bufLen) (I# initPos#) s = shoveString n ls = case ls of [] -> - if n ==# 0# then - CCALL(setBufWPtr) obj (0::Int) - else do {- At the end of a buffer write, update the buffer position in the underlying file object, so that if the handle @@ -595,13 +547,13 @@ writeBlocks obj buf (I# bufLen) (I# initPos#) s = alltogether. -} - CCALL(setBufWPtr) obj (I# n) + setBufWPtr obj (I# n) ((C# x):xs) -> do write_char buf n x if n ==# bufLen then do - rc <- mayBlock obj (CCALL(writeFileObject) obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block. + rc <- mayBlock obj (writeFileObject obj (I# (n +# 1#))) -- ConcHask: UNSAFE, may block. if rc == 0 then shoveString 0# xs else constructErrorAndFail "writeChunks" @@ -618,7 +570,7 @@ writeChars :: Addr -> String -> IO () #endif writeChars _fo "" = return () writeChars fo (c:cs) = do - rc <- mayBlock fo (CCALL(filePutc) fo c) -- ConcHask: UNSAFE, may block. + rc <- mayBlock fo (filePutc fo c) -- ConcHask: UNSAFE, may block. if rc == 0 then writeChars fo cs else constructErrorAndFail "writeChars" @@ -740,6 +692,384 @@ readLn = do l <- getLine r <- readIO l return r -#endif /* ndef HEAD */ \end{code} + +#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 = primRunST nh_stdin, + mut = primRunST (newIORef (Handle_Mut { state = HOpen })), + mode = ReadMode + } + +stdout + = Handle { + name = "stdout", + file = primRunST nh_stdout, + mut = primRunST (newIORef (Handle_Mut { state = HOpen })), + mode = WriteMode + } + +stderr + = Handle { + name = "stderr", + file = primRunST nh_stderr, + mut = primRunST (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 = primRunST (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) + putStrLn ( "hClose: state is " ++ show mut) + 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 +bracket_ before after m = do + x <- before + rs <- try m + after x + case rs of + Right r -> return r + Left e -> ioError e + +-- TODO: Hugs/slurpFile +slurpFile = unimp "IO.slurpFile" +\end{code} + +#endif /* #ifndef __HUGS__ */