Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1401a028
Commit
1401a028
authored
Mar 14, 1997
by
sof
Browse files
[project @ 1997-03-14 05:22:26 by sof]
OGI changes through 130397
parent
d8f5fc44
Changes
11
Hide whitespace changes
Inline
Side-by-side
ghc/lib/required/Array.lhs
View file @
1401a028
...
...
@@ -9,10 +9,10 @@
module Array (
module Ix, -- export all of Ix
Array, -- Array type abstract
ly
Array, -- Array type
is
abstract
array, listArray, (!), bounds, indices, elems, assocs,
accumArray, (//), accum,
amap,
ixmap
accumArray, (//), accum, ixmap
) where
import Ix
...
...
@@ -73,6 +73,9 @@ ixmap b f a = array b [(i, a ! f i) | i <- range b]
%*********************************************************
\begin{code}
instance Ix a => Functor (Array a) where
map = amap
instance (Ix a, Eq b) => Eq (Array a b) where
a == a' = assocs a == assocs a'
a /= a' = assocs a /= assocs a'
...
...
ghc/lib/required/Char.lhs
View file @
1401a028
...
...
@@ -7,15 +7,44 @@
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module Char (
isAscii, isControl, isPrint, isSpace, isUpper, isLower,
isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum, toUpper, toLower
) where
module Char
(
isAscii, isLatin1, isControl,
isPrint, isSpace, isUpper,
isLower, isAlpha, isDigit,
isOctDigit, isHexDigit, isAlphanum, -- :: Char -> Bool
toUpper, toLower, -- :: Char -> Char
digitToInt, -- :: Char -> Int
intToDigit, -- :: Int -> Char
ord, -- :: Char -> Int
chr, -- :: Int -> Char
readLitChar, -- :: ReadS Char
showLitChar -- :: Char -> ShowS
) where
import PrelBase
\end{code}
import PrelRead (readLitChar)
import IOBase (error)
\end{code}
\begin{code}
--Digitconversionoperations
digitToInt :: Char -> Int
digitToInt c
| isDigit c = fromEnum c - fromEnum '0'
| c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
| c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
| otherwise = error "Char.digitToInt: not a digit" -- sigh
intToDigit :: Int -> Char
intToDigit i
| i >= 0 && i <= 9 = toEnum (fromEnum '0' + i)
| i >= 10 && i <= 15 = toEnum (fromEnum 'a' + i -10)
| otherwise = error "Char.intToDigit: not a digit" -- ....
\end{code}
ghc/lib/required/Complex.lhs
View file @
1401a028
%
% (c) The AQUA Project, Glasgow University, 1994-199
6
% (c) The AQUA Project, Glasgow University, 1994-199
7
%
\section[Complex]{Module @Complex@}
...
...
ghc/lib/required/Directory.lhs
View file @
1401a028
%
% (c) The AQUA Project, Glasgow University, 1994-199
6
% (c) The AQUA Project, Glasgow University, 1994-199
7
%
\section[Directory]{Module @Directory@}
...
...
@@ -19,9 +19,15 @@ are relative to the current directory.
\begin{code}
module Directory (
-- Permissions(Permissions),
createDirectory, removeDirectory, removeFile,
renameDirectory, renameFile, getDirectoryContents,
getCurrentDirectory, setCurrentDirectory
{-
,doesFileExist, doesDirectoryExist,
getPermissions, setPermissions,
getModificationTime
-}
) where
import Prelude
...
...
@@ -51,39 +57,57 @@ setCurrentDirectory :: FilePath -> IO ()
%*********************************************************
%* *
\subsection{
Signature
s}
\subsection{
Permission
s}
%* *
%*********************************************************
$createDirectory dir$ creates a new directory
{\em dir} which is initially empty, or as near to empty as the
operating system allows.
The @Permissions@ type is used to record whether certain operations are permissible on a
file/directory:
\begin{code}
data Permissions
= Permissions {
readable, writeable,
executable, searchable :: Bool
} deriving (Eq, Ord, Read, Show)
\end{code}
%*********************************************************
%* *
\subsection{Implementation}
%* *
%*********************************************************
@createDirectory dir@ creates a new directory {\em dir} which is
initially empty, or as near to empty as the operating system
allows.
The operation may fail with:
\begin{itemize}
\item $AlreadyExists$
\item @isPermissionError@ / @PermissionDenied@
The process has insufficient privileges to perform the operation.
@[EROFS, EACCES]@
\item @isAlreadyExistsError@ / @AlreadyExists@
The operand refers to a directory that already exists.
[
$
EEXIST
$
]
\item
$
HardwareFault
$
@
[EEXIST]
@
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
The operand is not a valid directory name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@
NoSuchThing
@
There is no path to the directory.
[$ENOENT$, $ENOTDIR$]
\item $PermissionDenied$
The process has insufficient privileges to perform the operation.
[$EROFS$, $EACCES$]
\item $ResourceExhausted$
@[ENOENT, ENOTDIR]@
\item @ResourceExhausted@
Insufficient resources (virtual memory, process file descriptors,
physical disk space, etc.) are available to perform the operation.
[$EDQUOT$, $ENOSPC$, $ENOMEM$,
$EMLINK$]
\item $InappropriateType$
@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
\item @InappropriateType@
The path refers to an existing non-directory object.
[
$
EEXIST
$
]
@
[EEXIST]
@
\end{itemize}
\begin{code}
...
...
@@ -95,7 +119,7 @@ createDirectory path =
constructErrorAndFail "createDirectory"
\end{code}
$
removeDirectory dir
$
removes an existing directory {\em dir}. The
@
removeDirectory dir
@
removes an existing directory {\em dir}. The
implementation may specify additional constraints which must be
satisfied before a directory can be removed (e.g. the directory has to
be empty, or may not be in use by other processes). It is not legal
...
...
@@ -106,27 +130,27 @@ directory).
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
[
@
EIO
@
]
\item
@
InvalidArgument
@
The operand is not a valid directory name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExist@ / @
NoSuchThing
@
The directory does not exist.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EROFS
$
,
$
EACCES
$
,
$
EPERM
$
]
\item
$
UnsatisfiedConstraints
$
@
[EROFS, EACCES, EPERM]
@
\item
@
UnsatisfiedConstraints
@
Implementation-dependent constraints are not satisfied.
[
$
EBUSY
$
,
$
ENOTEMPTY
$
,
$
EEXIST
$
]
\item
$
UnsupportedOperation
$
@
[EBUSY, ENOTEMPTY, EEXIST]
@
\item
@
UnsupportedOperation
@
The implementation does not support removal in this situation.
[
$
EINVAL
$
]
\item
$
InappropriateType
$
@
[EINVAL]
@
\item
@
InappropriateType
@
The operand refers to an existing non-directory object.
[
$
ENOTDIR
$
]
@
[ENOTDIR]
@
\end{itemize}
\begin{code}
...
...
@@ -138,7 +162,7 @@ removeDirectory path =
constructErrorAndFail "removeDirectory"
\end{code}
$
removeFile file
$
removes the directory entry for an existing file
@
removeFile file
@
removes the directory entry for an existing file
{\em file}, where {\em file} is not itself a directory. The
implementation may specify additional constraints which must be
satisfied before a file can be removed (e.g. the file may not be in
...
...
@@ -146,24 +170,24 @@ use by other processes).
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
The operand is not a valid file name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExist@ / @
NoSuchThing
@
The file does not exist.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EROFS
$
,
$
EACCES
$
,
$
EPERM
$
]
\item
$
UnsatisfiedConstraints
$
@
[EROFS, EACCES, EPERM]
@
\item
@
UnsatisfiedConstraints
@
Implementation-dependent constraints are not satisfied.
[
$
EBUSY
$
]
\item
$
InappropriateType
$
@
[EBUSY]
@
\item
@
InappropriateType
@
The operand refers to an existing directory.
[
$
EPERM
$
,
$
EINVAL
$
]
@
[EPERM, EINVAL]
@
\end{itemize}
\begin{code}
...
...
@@ -175,7 +199,7 @@ removeFile path =
constructErrorAndFail "removeFile"
\end{code}
$
renameDirectory old
$
{\em new} changes the name of an existing
@
renameDirectory old
@
{\em new} changes the name of an existing
directory from {\em old} to {\em new}. If the {\em new} directory
already exists, it is atomically replaced by the {\em old} directory.
If the {\em new} directory is neither the {\em old} directory nor an
...
...
@@ -187,31 +211,30 @@ must be documented.
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
Either operand is not a valid directory name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExistError@ / @
NoSuchThing
@
The original directory does not exist, or there is no path to the target.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EROFS
$
,
$
EACCES
$
,
$
EPERM
$
]
\item
$
ResourceExhausted
$
@
[EROFS, EACCES, EPERM]
@
\item
@
ResourceExhausted
@
Insufficient resources are available to perform the operation.
[$EDQUOT$, $ENOSPC$, $ENOMEM$,
$EMLINK$]
\item $UnsatisfiedConstraints$
@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
\item @UnsatisfiedConstraints@
Implementation-dependent constraints are not satisfied.
[
$
EBUSY
$
,
$
ENOTEMPTY
$
,
$
EEXIST
$
]
\item
$
UnsupportedOperation
$
@
[EBUSY, ENOTEMPTY, EEXIST]
@
\item
@
UnsupportedOperation
@
The implementation does not support renaming in this situation.
[
$
EINVAL
$
,
$
EXDEV
$
]
\item
$
InappropriateType
$
@
[EINVAL, EXDEV]
@
\item
@
InappropriateType
@
Either path refers to an existing non-directory object.
[
$
ENOTDIR
$
,
$
EISDIR
$
]
@
[ENOTDIR, EISDIR]
@
\end{itemize}
\begin{code}
...
...
@@ -223,7 +246,7 @@ renameDirectory opath npath =
constructErrorAndFail "renameDirectory"
\end{code}
$
renameFile old
$
{\em new} changes the name of an existing file system
@
renameFile old
@
{\em new} changes the name of an existing file system
object from {\em old} to {\em new}. If the {\em new} object already
exists, it is atomically replaced by the {\em old} object. Neither
path may refer to an existing directory. A conformant implementation
...
...
@@ -233,32 +256,30 @@ documented.
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
Either operand is not a valid file name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExistError@ / @
NoSuchThing
@
The original file does not exist, or there is no path to the target.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EROFS
$
,
$
EACCES
$
,
$
EPERM
$
]
\item
$
ResourceExhausted
$
@
[EROFS, EACCES, EPERM]
@
\item
@
ResourceExhausted
@
Insufficient resources are available to perform the operation.
[$EDQUOT$, $ENOSPC$, $ENOMEM$,
$EMLINK$]
\item $UnsatisfiedConstraints$
@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
\item @UnsatisfiedConstraints@
Implementation-dependent constraints are not satisfied.
[
$
EBUSY
$
]
\item
$
UnsupportedOperation
$
@
[EBUSY]
@
\item
@
UnsupportedOperation
@
The implementation does not support renaming in this situation.
[
$
EXDEV
$
]
\item
$
InappropriateType
$
@
[EXDEV]
@
\item
@
InappropriateType
@
Either path refers to an existing directory.
[$ENOTDIR$, $EISDIR$, $EINVAL$,
$EEXIST$, $ENOTEMPTY$]
@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
\end{itemize}
\begin{code}
...
...
@@ -270,29 +291,29 @@ renameFile opath npath =
constructErrorAndFail "renameFile"
\end{code}
$
getDirectoryContents dir
$
returns a list of
<i>all</i> entries
in {\em dir}.
@
getDirectoryContents dir
@
returns a list of
{\em all} entries
in {\em dir}.
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
The operand is not a valid directory name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExistError@ / @
NoSuchThing
@
The directory does not exist.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EACCES
$
]
\item
$
ResourceExhausted
$
@
[EACCES]
@
\item
@
ResourceExhausted
@
Insufficient resources are available to perform the operation.
[
$
EMFILE
$
,
$
ENFILE
$
]
\item
$
InappropriateType
$
@
[EMFILE, ENFILE]
@
\item
@
InappropriateType
@
The path refers to an existing non-directory object.
[
$
ENOTDIR
$
]
@
[ENOTDIR]
@
\end{itemize}
\begin{code}
...
...
@@ -319,23 +340,23 @@ getDirectoryContents path =
\end{code}
If the operating system has a notion of current directories,
$
getCurrentDirectory
$
returns an absolute path to the
@
getCurrentDirectory
@
returns an absolute path to the
current directory of the calling process.
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
NoSuchThing
$
@
[EIO]
@
\item
@isDoesNotExistError@ / @
NoSuchThing
@
There is no path referring to the current directory.
[
$
EPERM
$
,
$
ENOENT
$
,
$
ESTALE
$
...]
\item
$
PermissionDenied
$
@
[EPERM, ENOENT, ESTALE...]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EACCES
$
]
\item
$
ResourceExhausted
$
@
[EACCES]
@
\item
@
ResourceExhausted
@
Insufficient resources are available to perform the operation.
\item
$
UnsupportedOperation
$
\item
@
UnsupportedOperation
@
The operating system has no notion of current directory.
\end{itemize}
...
...
@@ -352,29 +373,29 @@ getCurrentDirectory =
\end{code}
If the operating system has a notion of current directories,
$
setCurrentDirectory dir
$
changes the current
@
setCurrentDirectory dir
@
changes the current
directory of the calling process to {\em dir}.
The operation may fail with:
\begin{itemize}
\item
$
HardwareFault
$
\item
@
HardwareFault
@
A physical I/O error has occurred.
[
$
EIO
$
]
\item
$
InvalidArgument
$
@
[EIO]
@
\item
@
InvalidArgument
@
The operand is not a valid directory name.
[
$
ENAMETOOLONG
$
,
$
ELOOP
$
]
\item
$
NoSuchThing
$
@
[ENAMETOOLONG, ELOOP]
@
\item
@isDoesNotExistError@ / @
NoSuchThing
@
The directory does not exist.
[
$
ENOENT
$
,
$
ENOTDIR
$
]
\item
$
PermissionDenied
$
@
[ENOENT, ENOTDIR]
@
\item
@isPermissionError@ / @
PermissionDenied
@
The process has insufficient privileges to perform the operation.
[
$
EACCES
$
]
\item
$
UnsupportedOperation
$
@
[EACCES]
@
\item
@
UnsupportedOperation
@
The operating system has no notion of current directory, or the
current directory cannot be dynamically changed.
\item
$
InappropriateType
$
\item
@
InappropriateType
@
The path refers to an existing non-directory object.
[
$
ENOTDIR
$
]
@
[ENOTDIR]
@
\end{itemize}
\begin{code}
...
...
@@ -387,3 +408,38 @@ setCurrentDirectory path =
\end{code}
\begin{code}
{-
doesFileExist :: FilePath -> IO Bool
doesFileExist name =
psToByteArrayST name `thenIO_Prim` \ path ->
_ccall_ access path (``F_OK''::Int) `thenIO_Prim` \ rc ->
return (rc == 0)
doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist name =
(getFileStatus >>= isDirectory) `catch` (\ _ -> return False)
getModificationTime :: FilePath -> IO Bool
getModificationTime name =
getFileStatus >>= \ st ->
return (modificationTime st)
getPermissions :: FilePath -> IO Permissions
getPermissions name =
getFileStatus >>= \ st ->
let
fm = fileMode st
isect v = intersectFileMode v fm == v
in
return (
Permissions {
readable = isect ownerReadMode,
writeable = isect ownerWriteMode,
executable = not (isDirectory st) && isect ownerExecuteMode,
searchable = not (isRegularFile st) && isect ownerExecuteMode
}
)
-}
\end{code}
ghc/lib/required/IO.lhs
View file @
1401a028
...
...
@@ -5,7 +5,7 @@
\section[IO]{Module @IO@}
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
{-# OPTIONS -fno-implicit-prelude
-#include "cbits/stgio.h"
#-}
module IO (
Handle, HandlePosn,
...
...
@@ -15,13 +15,19 @@ module IO (
SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
stdin, stdout, stderr,
openFile, hClose, hFileSize, hIsEOF, isEOF,
hSetBuffering, hGetBuffering, hFlush, hGetPosn, hSetPosn, hSeek,
hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable, hReady,
hGetChar, hLookAhead, hGetContents, hPutChar, hPutStr, hPrint,
isAlreadyExistsError, isAlreadyInUseError, isFullError, isEOFError,
openFile, hClose,
hFileSize, hIsEOF, isEOF,
hSetBuffering, hGetBuffering, hFlush,
hGetPosn, hSetPosn, hSeek,
hReady, hGetChar, hLookAhead, hGetContents,
hPutChar, hPutStr, hPutStrLn, hPrint,
hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
isFullError, isEOFError,
isIllegalOperation, isPermissionError, isUserError,
ioeGetErrorString,
ioeGetHandle, ioeGetFileName
) where
...
...
@@ -33,6 +39,7 @@ import IOHandle -- much of the real stuff is in here
import PackedString ( nilPS, packCBytesST, unpackPS )
import PrelBase
import GHC
import Foreign ( makeForeignObj )
\end{code}
%*********************************************************
...
...
@@ -59,11 +66,13 @@ hLookAhead :: Handle -> IO Char
hPrint :: Show a => Handle -> a -> IO ()
hPutChar :: Handle -> Char -> IO ()
hPutStr :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
hReady :: Handle -> IO Bool
--IOHandle:hSeek :: Handle -> SeekMode -> Integer -> IO ()
--IOHandle:hSetBuffering :: Handle -> BufferMode -> IO ()
--IOHandle:hSetPosn :: HandlePosn -> IO ()
-- ioeGetFileName :: IOError -> Maybe FilePath
-- ioeGetErrorString :: IOError -> Maybe String
-- ioeGetHandle :: IOError -> Maybe Handle
-- isAlreadyExistsError :: IOError -> Bool
-- isAlreadyInUseError :: IOError -> Bool
...
...
@@ -96,16 +105,16 @@ hReady handle =
fail ioError
ClosedHandle ->
writeHandle handle htype >>
fail (IllegalOperation "handle is closed")
ioe_closedHandle handle
SemiClosedHandle _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is closed")
ioe_closedHandle handle
AppendHandle _ _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is not open for reading")
fail (
IOError (Just handle)
IllegalOperation "handle is not open for reading")
WriteHandle _ _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is not open for reading")
fail (
IOError (Just handle)
IllegalOperation "handle is not open for reading")
other ->
_ccall_ inputReady (filePtr other) `thenIO_Prim` \ rc ->
writeHandle handle (markHandle htype) >>
...
...
@@ -129,16 +138,16 @@ hGetChar handle =
fail ioError
ClosedHandle ->
writeHandle handle htype >>
fail (IllegalOperation "handle is closed")
ioe_closedHandle handle
SemiClosedHandle _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is closed")
ioe_closedHandle handle
AppendHandle _ _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is not open for reading")
fail (
IOError (Just handle)
IllegalOperation "handle is not open for reading")
WriteHandle _ _ _ ->
writeHandle handle htype >>
fail (IllegalOperation "handle is not open for reading")
fail (
IOError (Just handle)
IllegalOperation "handle is not open for reading")
other ->
_ccall_ fileGetc (filePtr other) `thenIO_Prim` \ intc ->
writeHandle handle (markHandle htype) >>
...
...
@@ -163,16 +172,16 @@ hLookAhead handle =
fail ioError
ClosedHandle ->
writeHandle handle htype >>