% ------------------------------------------------------------------------------
-% $Id: PrelHandle.lhs,v 1.62 2000/09/14 14:24:02 simonmar Exp $
+% $Id: PrelHandle.lhs,v 1.65 2001/01/11 07:04:16 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")
+ then ioException (IOError Nothing ResourceExhausted
+ "mkBuffer__" "not enough virtual memory" Nothing)
else return chunk
setBuf fo chunk sz_in_bytes
\end{code}
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__
(IOError (Just handle)
InvalidArgument
"hSetBuffering"
- ("illegal buffer size " ++ showsPrec 9 n []))
+ ("illegal buffer size " ++ showsPrec 9 n [])
-- 9 => should be parens'ified.
+ Nothing)
_ ->
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"
+ioeGetErrorString (IOException (IOError _ iot _ str _)) =
+ 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"
+ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
+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
_ -> act handle_
where
not_readable_error =
- IOError (Just handle) IllegalOperation fun
- ("handle is not open for reading")
+ IOError (Just handle) IllegalOperation fun
+ "handle is not open for reading" Nothing
wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantWriteableHandle fun handle act =
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
+ ReadHandle -> ioException not_writeable_error
_ -> act
where
not_writeable_error =
- IOException (IOError (Just handle) IllegalOperation fun
- ("handle is not open for writing"))
+ IOError (Just handle) IllegalOperation fun
+ "handle is not open for writing" Nothing
wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
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_
\begin{code}
ioe_closedHandle :: String -> Handle -> IO a
-ioe_closedHandle fun h = ioError (IOException (IOError (Just h) IllegalOperation fun
- "handle is closed"))
+ioe_closedHandle fun h = ioException (IOError (Just h) IllegalOperation fun
+ "handle is closed" Nothing)
\end{code}
Internal helper functions for Concurrent Haskell implementation
projects / ghc-hetmet.git / blobdiff