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 -- commitBuffer handle buf sz count flush
371 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
372 -- 'count' bytes of data) to handle (handle must be block or line buffered).
376 -- for block/line buffering,
377 -- 1. If there isn't room in the handle buffer, flush the handle
380 -- 2. If the handle buffer is empty,
382 -- then write buf directly to the device.
383 -- else swap the handle buffer with buf.
385 -- 3. If the handle buffer is non-empty, copy buf into the
386 -- handle buffer. Then, if flush != 0, flush
389 commitAndReleaseBuffer
390 :: Handle -- handle to commit to
391 -> Addr -> Int -- address and size (in bytes) of buffer
392 -> Int -- number of bytes of data in buffer
393 -> Bool -- flush the handle afterward?
395 commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
398 -- First deal with any possible exceptions by freeing the buffer.
399 -- Async exceptions are blocked, but there are still some interruptible
402 -- note that commit doesn't *always* free the buffer, it might
403 -- swap it for the current handle buffer instead. This makes things
404 -- a whole lot more complicated, because we can't just do
405 -- "finally (... free buffer ...)" here.
406 catchException (commit hdl h_)
407 (\e -> do { h_ <- freeBuffer h_ buf sz; putMVar h h_ })
410 commit hdl@(Handle h) handle_ =
411 checkWriteableHandle "commitAndReleaseBuffer" hdl handle_ $ do
412 let fo = haFO__ handle_
413 flushConnectedBuf fo -- ???? -SDM
414 getWriteableBuf fo -- flush read buf if necessary
416 fo_wptr <- getBufWPtr fo
417 fo_bufSize <- getBufSize fo
419 let ok h_ = putMVar h h_ >> return ()
421 if (fo_bufSize - fo_wptr < count) -- not enough room in handle buffer?
423 then do rc <- mayBlock fo (flushFile fo)
425 then constructErrorAndFail "commitBuffer"
427 if flush || sz /= fo_bufSize
428 then do rc <- write_buf fo buf count
430 then constructErrorAndFail "commitBuffer"
431 else do handle_ <- freeBuffer handle_ buf sz
434 -- don't have to flush, and the new buffer is the
435 -- same size as the old one, so just swap them...
436 else do handle_ <- swapBuffers handle_ buf sz
440 else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
441 setBufWPtr fo (fo_wptr + count)
443 then do rc <- mayBlock fo (flushFile fo)
445 then constructErrorAndFail "commitBuffer"
446 else do handle_ <- freeBuffer handle_ buf sz
448 else do handle_ <- freeBuffer handle_ buf sz
452 :: Handle -- handle to commit to
453 -> Addr -> Int -- address and size (in bytes) of buffer
454 -> Int -- number of bytes of data in buffer
455 -> Bool -- flush the handle afterward?
457 commitBuffer handle buf sz count flush = do
458 wantWriteableHandle "commitBuffer" handle $ \handle_ -> do
459 let fo = haFO__ handle_
460 flushConnectedBuf fo -- ???? -SDM
461 getWriteableBuf fo -- flush read buf if necessary
463 fo_wptr <- getBufWPtr fo
464 fo_bufSize <- getBufSize fo
466 (if (fo_bufSize - fo_wptr < count) -- not enough room in handle buffer?
467 then mayBlock fo (flushFile fo)
470 if (fo_bufSize < count) -- committed buffer too large?
472 then do rc <- write_buf fo buf count
473 if rc < 0 then constructErrorAndFail "commitBuffer"
476 else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
477 setBufWPtr fo (fo_wptr + count)
478 (if flush then mayBlock fo (flushFile fo) else return 0)
481 write_buf fo buf 0 = return 0
482 write_buf fo buf count = do
483 rc <- mayBlock fo (write_ fo buf count)
485 then write_buf fo buf (count - rc) -- partial write
488 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
491 Going across the border between Haskell and C is relatively costly,
492 so for block writes we pack the character strings on the Haskell-side
493 before passing the external write routine a pointer to the buffer.
498 #ifdef __CONCURRENT_HASKELL__
499 /* See comment in shoveString below for explanation */
500 #warning delayed update of buffer disnae work with killThread
503 writeLines :: Handle -> Addr -> Int -> String -> IO ()
504 writeLines handle buf bufLen s =
506 shoveString :: Int -> [Char] -> IO ()
509 [] -> commitAndReleaseBuffer handle buf buflen n False{-no need to flush-}
512 primWriteCharOffAddr buf n x
513 {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
515 if next_n == bufLen || x == '\n'
517 commitBuffer hdl buf len next_n True{-needs flush-}
520 shoveString next_n xs
524 #else /* ndef __HUGS__ */
526 writeLines :: Handle -> Addr -> Int -> String -> IO ()
527 writeLines hdl buf len@(I# bufLen) s =
529 shoveString :: Int# -> [Char] -> IO ()
532 [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
536 -- Flushing on buffer exhaustion or newlines
537 -- (even if it isn't the last one)
539 if next_n ==# bufLen || x `eqChar#` '\n'#
541 commitBuffer hdl buf len (I# next_n) True{-needs flush-}
544 shoveString next_n xs
547 #endif /* ndef __HUGS__ */
550 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
551 writeBlocks hdl buf bufLen s =
553 shoveString :: Int -> [Char] -> IO ()
556 [] -> commitAndReleaseBuffer hdl buf len n False{-no need to flush-}
559 primWriteCharOffAddr buf n x
563 commitBuffer hdl buf len next_n True{-needs flush-}
566 shoveString next_n xs
570 #else /* ndef __HUGS__ */
572 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
573 writeBlocks hdl buf len@(I# bufLen) s =
575 shoveString :: Int# -> [Char] -> IO ()
578 [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
585 commitBuffer hdl buf len (I# next_n) True{-needs flush-}
588 shoveString next_n xs
592 write_char :: Addr -> Int# -> Char# -> IO ()
593 write_char (A# buf#) n# c# =
595 case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
596 #endif /* ndef __HUGS__ */
599 Computation @hPrint hdl t@ writes the string representation of {\em t}
600 given by the @shows@ function to the file or channel managed by {\em
603 [ Seem to have disappeared from the 1.4 interface - SOF 2/97 ]
606 hPrint :: Show a => Handle -> a -> IO ()
607 hPrint hdl = hPutStrLn hdl . show
610 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
611 the handle \tr{hdl}, adding a newline at the end.
614 hPutStrLn :: Handle -> String -> IO ()
615 hPutStrLn hndl str = do