-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_))
-
-\end{code}
-
-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}
-#ifndef __PARALLEL_HASKELL__
-lazyReadBlock :: Handle -> ForeignObj -> IO String
-lazyReadLine :: Handle -> ForeignObj -> IO String
-lazyReadChar :: Handle -> ForeignObj -> IO String
-#else
-lazyReadBlock :: Handle -> Addr -> IO String
-lazyReadLine :: Handle -> Addr -> IO String
-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.
- 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 ""
- _ -> 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.
- 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 ""
- _ -> do
- more <- unsafeInterleaveIO (lazyReadLine handle fo)
- buf <- CCALL(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.
- 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
- CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flusing-} -- ConcHask: SAFE, won't block
- writeHandle handle (handle_{ haType__ = ClosedHandle,
- haFO__ = nullFile__ })
- return ""
- _ -> do
- more <- unsafeInterleaveIO (lazyReadChar handle fo)
- return (chr char : more)
-
-\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{Simple output functions}
-%* *
-%*********************************************************
-
-@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 =
- 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_
- 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 <- CCALL(getWriteableBuf) fo
- pos <- CCALL(getBufWPtr) fo
- bsz <- CCALL(getBufSize) fo
- writeLines fo buf bsz pos str
- BlockBuffering _ -> do
- buf <- CCALL(getWriteableBuf) fo
- pos <- CCALL(getBufWPtr) fo
- bsz <- CCALL(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,
-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}
-#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
- [] ->
- 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
- 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.
-
- -}
- CCALL(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.
- 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 -> Addr -> Int -> Int -> String -> IO ()
-#else
-writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
-#endif
-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
- [] ->
- 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
- 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.
-
- -}
- CCALL(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.
- if rc == 0
- then shoveString 0# xs
- else constructErrorAndFail "writeLines"