% ------------------------------------------------------------------------------
-% $Id: PrelHandle.lhs,v 1.60 2000/07/25 15:20:10 simonmar Exp $
+% $Id: PrelHandle.lhs,v 1.64 2001/01/10 16:28:15 qrczak Exp $
%
% (c) The AQUA Project, Glasgow University, 1994-2000
%
import PrelAddr ( Addr, nullAddr )
import PrelByteArr ( ByteArray(..) )
import PrelRead ( Read )
-import PrelList ( span )
+import PrelList ( break )
import PrelIOBase
import PrelMaybe ( Maybe(..) )
import PrelException
case sz_in_bytes of
0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
_ -> do
- chunk <- allocMemory__ sz_in_bytes
+ chunk <- malloc sz_in_bytes
if chunk == nullAddr
then ioException (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
else return chunk
withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
{-# INLINE withHandle #-}
withHandle (Handle h) act =
- blockAsyncExceptions $ do
+ block $ do
h_ <- takeMVar h
(h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
putMVar h h'
withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
{-# INLINE withHandle_ #-}
withHandle_ (Handle h) act =
- blockAsyncExceptions $ do
+ block $ do
h_ <- takeMVar h
v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
putMVar h h_
withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
{-# INLINE withHandle__ #-}
withHandle__ (Handle h) act =
- blockAsyncExceptions $ do
+ block $ do
h_ <- takeMVar h
h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
putMVar h h'
haFilePath__ = "closed file",
haBuffers__ = []
}
-
-mkErrorHandle__ :: IOException -> Handle__
-mkErrorHandle__ ioe =
- Handle__ { haFO__ = nullFile__,
- haType__ = (ErrorHandle ioe),
- haBufferMode__ = NoBuffering,
- haFilePath__ = "error handle",
- haBuffers__ = []
- }
\end{code}
%*********************************************************
#endif
return hdl
- _ -> do ioError <- constructError "stdout"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stdout"
)
stdin = unsafePerformIO (do
#endif
hConnectTerms stdout hdl
return hdl
- _ -> do ioError <- constructError "stdin"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stdin"
)
hConnectTo stdout hdl
return hdl
- _ -> do ioError <- constructError "stderr"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stderr"
)
\end{code}
hClose handle =
withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return handle_
_ -> do
rc <- closeFile (haFO__ handle_)
hFileSize handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hFileSize" handle
SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
#ifdef __HUGS__
_ ->
withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
_ -> do
{- Note:
hIsOpen handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return False
SemiClosedHandle -> return False
_ -> return True
hIsClosed handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return True
_ -> return False
hIsReadable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsReadable" handle
SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
htype -> return (isReadable htype)
hIsWritable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsWritable" handle
SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
htype -> return (isWritable htype)
hGetBuffering handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
_ ->
{-
hIsSeekable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
AppendHandle -> return False
else
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hSetEcho" handle
_ -> do
rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
else
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hGetEcho" handle
_ -> do
rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
hIsTerminalDevice handle = do
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
_ -> do
rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
ioError (userError "slurpFile: file too big")
else do
let sz_i = fromInteger sz
- chunk <- allocMemory__ sz_i
+ chunk <- malloc sz_i
if chunk == nullAddr
then do
hClose handle
getHandleFd handle =
withHandle_ handle $ \ handle_ -> do
case (haType__ handle_) of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "getHandleFd" handle
_ -> do
fd <- getFileFd (haFO__ handle_)
ioeGetErrorString :: IOError -> String
ioeGetHandle :: IOError -> Maybe Handle
-ioeGetHandle (IOException (IOError h _ _ _)) = h
-ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
+ioeGetHandle (IOException (IOError h _ _ _)) = h
+ioeGetHandle (UserError _) = Nothing
+ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
ioeGetErrorString (IOException (IOError _ iot _ str)) =
- case iot of
- EOF -> "end of file"
- _ -> str
-ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
+ case iot of
+ EOF -> "end of file"
+ _ -> str
+ioeGetErrorString (UserError str) = str
+ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
ioeGetFileName (IOException (IOError _ _ _ str)) =
- case span (/=':') str of
- (_,[]) -> Nothing
- (fs,_) -> Just fs
-ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
+ case break (== ':') str of
+ (_, []) -> Nothing
+ (_, _:' ':fs)-> Just fs
+ioeGetFileName (UserError _) = Nothing
+ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
\end{code}
'Top-level' IO actions want to catch exceptions (e.g., forkIO and
wantReadableHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
AppendHandle -> ioException not_readable_error
checkWriteableHandle fun handle handle_ act
= case haType__ handle_ of
- ErrorHandle theError -> ioError (IOException theError)
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
ReadHandle -> ioError not_writeable_error
wantRWHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
_ -> act handle_
wantSeekableHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
_ -> act handle_
- where
- not_seekable_error =
- IOException (IOError (Just handle)
- IllegalOperation fun
- ("handle is not seekable"))
-
\end{code}
Internal function for creating an @IOError@ representing the