2 % (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrelIO]{Module @PrelIO@}
6 This module defines all basic IO operations.
7 These are needed for the IO operations exported by Prelude,
8 but as it happens they also do everything required by library
13 {-# OPTIONS -fcompiling-prelude -fno-implicit-prelude -#include "cbits/stgio.h" #-}
20 import PrelHandle -- much of the real stuff is in here
23 import PrelRead ( readParen, Read(..), reads, lex,
27 import PrelMaybe ( Either(..), Maybe(..) )
28 import PrelAddr ( Addr(..), AddrOff(..), nullAddr, plusAddr )
29 import PrelByteArr ( ByteArray )
30 import PrelPack ( unpackNBytesAccST )
31 import PrelException ( ioError, catch, catchException, throw, blockAsyncExceptions )
36 %*********************************************************
38 \subsection{Standard IO}
40 %*********************************************************
42 The Prelude has from Day 1 provided a collection of common
43 IO functions. We define these here, but let the Prelude
47 putChar :: Char -> IO ()
48 putChar c = hPutChar stdout c
50 putStr :: String -> IO ()
51 putStr s = hPutStr stdout s
53 putStrLn :: String -> IO ()
54 putStrLn s = do putStr s
57 print :: Show a => a -> IO ()
58 print x = putStrLn (show x)
61 getChar = hGetChar stdin
64 getLine = hGetLine stdin
66 getContents :: IO String
67 getContents = hGetContents stdin
69 interact :: (String -> String) -> IO ()
70 interact f = do s <- getContents
73 readFile :: FilePath -> IO String
74 readFile name = openFile name ReadMode >>= hGetContents
76 writeFile :: FilePath -> String -> IO ()
77 writeFile name str = do
78 hdl <- openFile name WriteMode
82 appendFile :: FilePath -> String -> IO ()
83 appendFile name str = do
84 hdl <- openFile name AppendMode
88 readLn :: Read a => IO a
89 readLn = do l <- getLine
95 %*********************************************************
97 \subsection{Simple input operations}
99 %*********************************************************
101 Computation @hReady hdl@ indicates whether at least
102 one item is available for input from handle {\em hdl}.
104 @hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
105 before deciding whether the Handle has run dry or not.
107 If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
108 If not, it tries to read from the underlying OS handle. Notice that
109 for buffered Handles connected to terminals this means waiting until a complete
113 hReady :: Handle -> IO Bool
114 hReady h = hWaitForInput h 0
116 hWaitForInput :: Handle -> Int -> IO Bool
117 hWaitForInput handle msecs =
118 wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
119 rc <- inputReady (haFO__ handle_) (msecs::Int) -- ConcHask: SAFE, won't block
123 _ -> constructErrorAndFail "hWaitForInput"
126 @hGetChar hdl@ reads the next character from handle @hdl@,
127 blocking until a character is available.
130 hGetChar :: Handle -> IO Char
132 c <- mayBlockRead "hGetChar" handle fileGetc
136 If EOF is reached before EOL is encountered, ignore the
137 EOF and return the partial line. Next attempt at calling
138 hGetLine on the handle will yield an EOF IO exception though.
140 hGetLine :: Handle -> IO String
154 if isEOFError err then
166 @hLookahead hdl@ returns the next character from handle @hdl@
167 without removing it from the input buffer, blocking until a
168 character is available.
171 hLookAhead :: Handle -> IO Char
172 hLookAhead handle = do
173 rc <- mayBlockRead "hLookAhead" handle fileLookAhead
178 %*********************************************************
180 \subsection{Getting the entire contents of a handle}
182 %*********************************************************
184 @hGetContents hdl@ returns the list of characters corresponding
185 to the unread portion of the channel or file managed by @hdl@,
186 which is made semi-closed.
189 hGetContents :: Handle -> IO String
190 hGetContents handle =
191 -- can't use wantReadableHandle here, because we want to side effect
193 withHandle handle $ \ handle_ -> do
194 case haType__ handle_ of
195 ErrorHandle theError -> ioError theError
196 ClosedHandle -> ioe_closedHandle "hGetContents" handle
197 SemiClosedHandle -> ioe_closedHandle "hGetContents" handle
198 AppendHandle -> ioError not_readable_error
199 WriteHandle -> ioError not_readable_error
202 To avoid introducing an extra layer of buffering here,
203 we provide three lazy read methods, based on character,
204 line, and block buffering.
206 let handle_' = handle_{ haType__ = SemiClosedHandle }
207 case (haBufferMode__ handle_) of
209 str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
210 return (handle_', str)
211 BlockBuffering _ -> do
212 str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
213 return (handle_', str)
215 str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
216 return (handle_', str)
219 IOError (Just handle) IllegalOperation "hGetContents"
220 ("handle is not open for reading")
223 Note that someone may close the semi-closed handle (or change its buffering),
224 so each these lazy read functions are pulled on, they have to check whether
225 the handle has indeed been closed.
228 #ifndef __PARALLEL_HASKELL__
229 lazyReadBlock :: Handle -> ForeignObj -> IO String
230 lazyReadLine :: Handle -> ForeignObj -> IO String
231 lazyReadChar :: Handle -> ForeignObj -> IO String
233 lazyReadBlock :: Handle -> Addr -> IO String
234 lazyReadLine :: Handle -> Addr -> IO String
235 lazyReadChar :: Handle -> Addr -> IO String
238 lazyReadBlock handle fo = do
239 buf <- getBufStart fo 0
240 bytes <- mayBlock fo (readBlock fo) -- ConcHask: UNSAFE, may block.
242 -3 -> -- buffering has been turned off, use lazyReadChar instead
243 lazyReadChar handle fo
245 -1 -> -- an error occurred, close the handle
246 withHandle handle $ \ handle_ -> do
247 closeFile (haFO__ handle_) 0{-don't bother flushing-} -- ConcHask: SAFE, won't block.
248 return (handle_ { haType__ = ClosedHandle,
249 haFO__ = nullFile__ },
252 more <- unsafeInterleaveIO (lazyReadBlock handle fo)
253 stToIO (unpackNBytesAccST buf bytes more)
255 lazyReadLine handle fo = do
256 bytes <- mayBlock fo (readLine fo) -- ConcHask: UNSAFE, may block.
258 -3 -> -- buffering has been turned off, use lazyReadChar instead
259 lazyReadChar handle fo
260 -2 -> return "" -- handle closed by someone else, stop reading.
261 -1 -> -- an error occurred, close the handle
262 withHandle handle $ \ handle_ -> do
263 closeFile (haFO__ handle_) 0{- don't bother flushing-} -- ConcHask: SAFE, won't block
264 return (handle_ { haType__ = ClosedHandle,
265 haFO__ = nullFile__ },
268 more <- unsafeInterleaveIO (lazyReadLine handle fo)
269 buf <- getBufStart fo bytes -- ConcHask: won't block
270 stToIO (unpackNBytesAccST buf bytes more)
272 lazyReadChar handle fo = do
273 char <- mayBlock fo (readChar fo) -- ConcHask: UNSAFE, may block.
275 -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
276 lazyReadBlock handle fo
278 -3 -> -- buffering is now line-buffered, use lazyReadLine instead
279 lazyReadLine handle fo
281 -1 -> -- error, silently close handle.
282 withHandle handle $ \ handle_ -> do
283 closeFile (haFO__ handle_) 0{-don't bother flusing-} -- ConcHask: SAFE, won't block
284 return (handle_{ haType__ = ClosedHandle,
285 haFO__ = nullFile__ },
288 more <- unsafeInterleaveIO (lazyReadChar handle fo)
289 return (chr char : more)
294 %*********************************************************
296 \subsection{Simple output functions}
298 %*********************************************************
300 @hPutChar hdl ch@ writes the character @ch@ to the file
301 or channel managed by @hdl@. Characters may be buffered if
302 buffering is enabled for @hdl@
305 hPutChar :: Handle -> Char -> IO ()
307 c `seq` do -- must evaluate c before grabbing the handle lock
308 wantWriteableHandle "hPutChar" handle $ \ handle_ -> do
309 let fo = haFO__ handle_
311 rc <- mayBlock fo (filePutc fo c) -- ConcHask: UNSAFE, may block.
314 else constructErrorAndFail "hPutChar"
316 hPutChars :: Handle -> [Char] -> IO ()
317 hPutChars handle [] = return ()
318 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
321 @hPutStr hdl s@ writes the string @s@ to the file or
322 channel managed by @hdl@, buffering the output if needs be.
326 hPutStr :: Handle -> String -> IO ()
327 hPutStr handle str = do
328 buffer_mode <- wantWriteableHandle_ "hPutStr" handle
329 (\ handle_ -> do getBuffer handle_)
331 (NoBuffering, _, _) -> do
332 hPutChars handle str -- v. slow, but we don't care
333 (LineBuffering, buf, bsz) -> do
334 writeLines handle buf bsz str
335 (BlockBuffering _, buf, bsz) -> do
336 writeBlocks handle buf bsz str
337 -- ToDo: async exceptions during writeLines & writeBlocks will cause
338 -- the buffer to get lost in the void. Using ByteArrays instead of
339 -- malloced buffers is one way around this, but we really ought to
340 -- be able to handle it with exception handlers/block/unblock etc.
342 getBuffer :: Handle__ -> IO (Handle__, (BufferMode, Addr, Int))
343 getBuffer handle_ = do
344 let bufs = haBuffers__ handle_
346 mode = haBufferMode__ handle_
349 NoBuffering -> return (handle_, (mode, nullAddr, 0))
351 [] -> do buf <- allocMemory__ sz
352 return (handle_, (mode, buf, sz))
353 (b:bs) -> return (handle_{ haBuffers__ = bs }, (mode, b, sz))
355 freeBuffer :: Handle__ -> Addr -> Int -> IO Handle__
356 freeBuffer handle_ buf sz = do
357 fo_sz <- getBufSize (haFO__ handle_)
359 then do { free buf; return handle_ }
360 else do { return handle_{ haBuffers__ = buf : haBuffers__ handle_ } }
362 swapBuffers :: Handle__ -> Addr -> Int -> IO Handle__
363 swapBuffers handle_ buf sz = do
364 let fo = haFO__ handle_
367 return (handle_{ haBuffers__ = fo_buf : haBuffers__ handle_ })
369 -----------------------------------------------------------------------------------
370 -- commitAndReleaseBuffer handle buf sz count flush
372 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
373 -- 'count' bytes of data) to handle (handle must be block or line buffered).
377 -- for block/line buffering,
378 -- 1. If there isn't room in the handle buffer, flush the handle
381 -- 2. If the handle buffer is empty,
383 -- then write buf directly to the device.
384 -- else swap the handle buffer with buf.
386 -- 3. If the handle buffer is non-empty, copy buf into the
387 -- handle buffer. Then, if flush != 0, flush
390 commitAndReleaseBuffer
391 :: Handle -- handle to commit to
392 -> Addr -> Int -- address and size (in bytes) of buffer
393 -> Int -- number of bytes of data in buffer
394 -> Bool -- flush the handle afterward?
397 commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
400 -- First deal with any possible exceptions by freeing the buffer.
401 -- Async exceptions are blocked, but there are still some interruptible
404 -- note that commit doesn't *always* free the buffer, it might
405 -- swap it for the current handle buffer instead. This makes things
406 -- a whole lot more complicated, because we can't just do
407 -- "finally (... free buffer ...)" here.
408 catchException (commit hdl h_)
409 (\e -> do { h_ <- freeBuffer h_ buf sz; putMVar h h_ })
412 commit hdl@(Handle h) handle_ =
413 checkWriteableHandle "commitAndReleaseBuffer" hdl handle_ $ do
414 let fo = haFO__ handle_
415 flushConnectedBuf fo -- ???? -SDM
416 getWriteableBuf fo -- flush read buf if necessary
418 fo_wptr <- getBufWPtr fo
419 fo_bufSize <- getBufSize fo
421 let ok h_ = putMVar h h_ >> return ()
423 if (flush || fo_bufSize - fo_wptr < count) -- not enough room in handle buffer?
425 then do rc <- mayBlock fo (flushFile fo)
427 then constructErrorAndFail "commitAndReleaseBuffer"
429 if (flush || sz /= fo_bufSize)
430 then do rc <- write_buf fo buf count
432 then constructErrorAndFail "commitAndReleaseBuffer"
433 else do handle_ <- freeBuffer handle_ buf sz
436 -- don't have to flush, and the new buffer is the
437 -- same size as the old one, so just swap them...
438 else do handle_ <- swapBuffers handle_ buf sz
442 -- not flushing, and there's enough room in the buffer:
443 -- just copy the data in and update bufWPtr.
444 else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
445 setBufWPtr fo (fo_wptr + count)
446 handle_ <- freeBuffer handle_ buf sz
449 ------------------------------------------------------------------------------------
450 -- commitBuffer handle buf sz count flush
452 -- Flushes 'count' bytes from the buffer 'buf' (size 'sz') to 'handle'.
453 -- There are several cases to consider altogether:
456 -- - flush handle buffer,
457 -- - write out new buffer directly
460 -- - if there's enough room in the handle buffer, then copy new buf into it
461 -- else flush handle buffer, then copy new buffer into it
464 :: Handle -- handle to commit to
465 -> Addr -> Int -- address and size (in bytes) of buffer
466 -> Int -- number of bytes of data in buffer
467 -> Bool -- flush the handle afterward?
470 commitBuffer handle buf sz count flush = do
471 wantWriteableHandle "commitBuffer" handle $ \handle_ -> do
472 let fo = haFO__ handle_
473 flushConnectedBuf fo -- ???? -SDM
474 getWriteableBuf fo -- flush read buf if necessary
476 fo_wptr <- getBufWPtr fo
477 fo_bufSize <- getBufSize fo
479 new_wptr <- -- not enough room in handle buffer?
480 (if flush || (fo_bufSize - fo_wptr < count)
481 then do rc <- mayBlock fo (flushFile fo)
482 if (rc < 0) then constructErrorAndFail "commitBuffer"
484 else return fo_wptr )
486 if (flush || fo_bufSize < count) -- committed buffer too large?
488 then do rc <- write_buf fo buf count
489 if (rc < 0) then constructErrorAndFail "commitBuffer"
492 else do memcpy (plusAddr fo_buf (AddrOff# new_wptr)) buf count
493 setBufWPtr fo (new_wptr + count)
496 write_buf fo buf 0 = return 0
497 write_buf fo buf count = do
498 rc <- mayBlock fo (write_ fo buf count)
500 then write_buf fo buf (count - rc) -- partial write
503 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
506 Going across the border between Haskell and C is relatively costly,
507 so for block writes we pack the character strings on the Haskell-side
508 before passing the external write routine a pointer to the buffer.
513 #ifdef __CONCURRENT_HASKELL__
514 /* See comment in shoveString below for explanation */
515 #warning delayed update of buffer disnae work with killThread
518 writeLines :: Handle -> Addr -> Int -> String -> IO ()
519 writeLines handle buf bufLen s =
521 shoveString :: Int -> [Char] -> IO ()
524 [] -> commitAndReleaseBuffer handle buf buflen n False{-no need to flush-}
527 primWriteCharOffAddr buf n x
528 {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
530 if next_n == bufLen || x == '\n'
532 commitBuffer hdl buf len next_n True{-needs flush-}
535 shoveString next_n xs
539 #else /* ndef __HUGS__ */
541 writeLines :: Handle -> Addr -> Int -> String -> IO ()
542 writeLines hdl buf len@(I# bufLen) s =
544 shoveString :: Int# -> [Char] -> IO ()
547 [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
551 -- Flushing on buffer exhaustion or newlines
552 -- (even if it isn't the last one)
554 if next_n ==# bufLen || x `eqChar#` '\n'#
556 commitBuffer hdl buf len (I# next_n) True{-needs flush-}
559 shoveString next_n xs
562 #endif /* ndef __HUGS__ */
565 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
566 writeBlocks hdl buf bufLen s =
568 shoveString :: Int -> [Char] -> IO ()
571 [] -> commitAndReleaseBuffer hdl buf len n False{-no need to flush-}
574 primWriteCharOffAddr buf n x
578 commitBuffer hdl buf len next_n True{-needs flush-}
581 shoveString next_n xs
585 #else /* ndef __HUGS__ */
587 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
588 writeBlocks hdl buf len@(I# bufLen) s =
590 shoveString :: Int# -> [Char] -> IO ()
593 [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
600 commitBuffer hdl buf len (I# next_n) True{-needs flush-}
603 shoveString next_n xs
607 write_char :: Addr -> Int# -> Char# -> IO ()
608 write_char (A# buf#) n# c# =
610 case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
611 #endif /* ndef __HUGS__ */
614 Computation @hPrint hdl t@ writes the string representation of {\em t}
615 given by the @shows@ function to the file or channel managed by {\em
618 [ Seem to have disappeared from the 1.4 interface - SOF 2/97 ]
621 hPrint :: Show a => Handle -> a -> IO ()
622 hPrint hdl = hPutStrLn hdl . show
625 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
626 the handle \tr{hdl}, adding a newline at the end.
629 hPutStrLn :: Handle -> String -> IO ()
630 hPutStrLn hndl str = do