#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.1 2001/05/18 16:54:05 simonmar Exp $
+-- $Id: PrelIO.hsc,v 1.8 2001/08/04 06:10:04 ken Exp $
--
-- (c) The University of Glasgow, 1992-2001
--
import PrelMaybe
import PrelReal
import PrelNum
-import PrelRead ( Read(..), readIO )
+import PrelRead
import PrelShow
import PrelMaybe ( Maybe(..) )
import PrelPtr
r <- readIO l
return r
+ -- raises an exception instead of an error
+readIO :: Read a => String -> IO a
+readIO s = case (do { (x,t) <- reads s ;
+ ("","") <- lex t ;
+ return x }) of
+#ifndef NEW_READS_REP
+ [x] -> return x
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
+#else
+ Just x -> return x
+ Nothing -> ioError (userError "Prelude.readIO: no parse")
+#endif
+
-- ---------------------------------------------------------------------------
-- Simple input operations
hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
+maybeFillReadBuffer fd is_line buf
+ = catch
+ (do buf <- fillReadBuffer fd is_line buf
+ return (Just buf)
+ )
+ (\e -> do if isEOFError e
+ then return Nothing
+ else throw e)
+
+
unpack :: RawBuffer -> Int -> Int -> IO [Char]
unpack buf r 0 = return ""
unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
-- unread portion of the channel or file managed by the handle, which
-- is made semi-closed.
+-- hGetContents on a DuplexHandle only affects the read side: you can
+-- carry on writing to it afterwards.
+
hGetContents :: Handle -> IO String
hGetContents handle =
- -- can't use wantReadableHandle here, because we want to side effect
- -- the handle.
- withHandle "hGetContents" handle $ \ handle_ -> do
+ withHandle "hGetContents" handle $ \handle_ ->
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
- AppendHandle -> ioException not_readable_error
- WriteHandle -> ioException not_readable_error
+ AppendHandle -> ioe_notReadable
+ WriteHandle -> ioe_notReadable
_ -> do xs <- lazyRead handle
return (handle_{ haType=SemiClosedHandle}, xs )
- where
- not_readable_error =
- IOError (Just handle) IllegalOperation "hGetContents"
- "handle is not open for reading" Nothing
-- 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.
+-- buffering), so each time these lazy read functions are pulled on,
+-- they have to check whether the handle has indeed been closed.
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
- withHandle_ "lazyRead" handle $ \ handle_ -> do
+ withHandle "lazyRead" handle $ \ handle_ -> do
case haType handle_ of
- ClosedHandle -> return ""
+ ClosedHandle -> return (handle_, "")
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
-- (see hLookAhead)
buf <- readIORef ref
if not (bufferEmpty buf)
- then lazyReadBuffered h fd ref buf
+ then lazyReadHaveBuffer h handle_ fd ref buf
else do
case haBufferMode handle_ of
-- make use of the minimal buffer we already have
let raw = bufBuf buf
fd = haFD handle_
- r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
+ r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
(read_off (fromIntegral fd) raw 0 1)
(threadWaitRead fd)
if r == 0
- then return ""
+ then do handle_ <- hClose_help handle_
+ return (handle_, "")
else do (c,_) <- readCharFromBuffer raw 0
rest <- lazyRead h
- return (c : rest)
+ return (handle_, c : rest)
- LineBuffering -> lazyReadBuffered h fd ref buf
- BlockBuffering _ -> lazyReadBuffered h fd ref buf
+ LineBuffering -> lazyReadBuffered h handle_ fd ref buf
+ BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
-- we never want to block during the read, so we call fillReadBuffer with
-- is_line==True, which tells it to "just read what there is".
-lazyReadBuffered h fd ref buf = do
- maybe_new_buf <-
- if bufferEmpty buf
- then maybeFillReadBuffer fd True buf
- else return (Just buf)
- case maybe_new_buf of
- Nothing -> return ""
- Just buf -> do
- more <- lazyRead h
- writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
-
-
-maybeFillReadBuffer fd is_line buf
- = catch
- (do buf <- fillReadBuffer fd is_line buf
- return (Just buf)
- )
- (\e -> if isEOFError e
- then return Nothing
- else throw e)
+lazyReadBuffered h handle_ fd ref buf = do
+ catch
+ (do buf <- fillReadBuffer fd True{-is_line-} buf
+ lazyReadHaveBuffer h handle_ fd ref buf
+ )
+ -- all I/O errors are discarded. Additionally, we close the handle.
+ (\e -> do handle_ <- hClose_help handle_
+ return (handle_, "")
+ )
+
+lazyReadHaveBuffer h handle_ fd ref buf = do
+ more <- lazyRead h
+ writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
+ s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
+ return (handle_, s)
unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
-getSpareBuffer handle_ = do
- let mode = haBufferMode handle_
+getSpareBuffer Handle__{haBuffer=ref,
+ haBuffers=spare_ref,
+ haBufferMode=mode}
+ = do
case mode of
NoBuffering -> return (mode, error "no buffer!")
_ -> do
- let spare_ref = haBuffers handle_
- ref = haBuffer handle_
bufs <- readIORef spare_ref
buf <- readIORef ref
case bufs of
foreign import "memcpy_wrap" unsafe
memcpy_off :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
#def inline \
-void *memcpy_wrap(char *dst, int dst_off, char *src, size_t sz) \
+void *memcpy_wrap(char *dst, HsInt dst_off, const char *src, size_t sz) \
{ return memcpy(dst+dst_off, src, sz); }
-- ---------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff