getGroupEntryForID gid = do
ptr <- _ccall_ getgrgid gid
if ptr == nullAddr then
- fail (IOError Nothing NoSuchThing
+ ioError (IOError Nothing NoSuchThing
"getGroupEntryForID" "no such group entry")
else
unpackGroupEntry ptr
gname <- packStringIO name
ptr <- _ccall_ getgrnam gname
if ptr == nullAddr then
- fail (IOError Nothing NoSuchThing
+ ioError (IOError Nothing NoSuchThing
"getGroupEntryForName" "no such group entry")
else
unpackGroupEntry ptr
getUserEntryForID uid = do
ptr <- _ccall_ getpwuid uid
if ptr == nullAddr then
- fail (IOError Nothing NoSuchThing
+ ioError (IOError Nothing NoSuchThing
"getUserEntryForID" "no such user entry")
else
unpackUserEntry ptr
uname <- packStringIO name
ptr <- _ccall_ getpwnam uname
if ptr == nullAddr then
- fail (IOError Nothing NoSuchThing
+ ioError (IOError Nothing NoSuchThing
"getUserEntryForName" "no such user entry")
else
unpackUserEntry ptr
else do
errno <- getErrorCode
if errno == noError
- then fail (IOError Nothing EOF "readDirStream" "EOF")
+ then ioError (IOError Nothing EOF "readDirStream" "EOF")
else syserr "readDirStream"
rewindDirStream :: DirStream -> IO ()
closeDirStream :: DirStream -> IO ()
closeDirStream dirp = do
rc <- _ccall_ closedir dirp
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "closeDirStream"
openFd name how maybe_mode (OpenFileFlags append exclusive noctty nonBlock truncate) =
packStringIO name >>= \file ->
_ccall_ open file flags mode_w >>= \fd@(I# fd#) ->
- if fd /= -1
+ if fd /= ((-1)::Int)
then return (FD# fd#)
else syserr "openFd"
where
createFile name mode =
packStringIO name >>= \file ->
_ccall_ creat file mode >>= \fd@(I# fd#) ->
- if fd /= -1
+ if fd /= ((-1)::Int)
then return (FD# fd#)
else syserr "createFile"
path1 <- packStringIO name1
path2 <- packStringIO name2
rc <- _ccall_ link path1 path2
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "createLink"
createDirectory name mode = do -- NB: diff signature from LibDirectory one!
dir <- packStringIO name
rc <- _ccall_ mkdir dir mode
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "createDirectory"
createNamedPipe name mode = do
pipe <- packStringIO name
rc <-_ccall_ mkfifo pipe mode
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "createNamedPipe"
removeLink name = do
path <- packStringIO name
rc <-_ccall_ unlink path
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "removeLink"
path1 <- packStringIO name1
path2 <- packStringIO name2
rc <- _ccall_ rename path1 path2
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "rename"
isDirectory :: FileStatus -> Bool
isDirectory stat = unsafePerformIO $
_casm_ ``%r = S_ISDIR(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
- return (rc /= 0)
+ return (rc /= (0::Int))
isCharacterDevice :: FileStatus -> Bool
isCharacterDevice stat = unsafePerformIO $
_casm_ ``%r = S_ISCHR(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
- return (rc /= 0)
+ return (rc /= (0::Int))
isBlockDevice :: FileStatus -> Bool
isBlockDevice stat = unsafePerformIO $
_casm_ ``%r = S_ISBLK(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
- return (rc /= 0)
+ return (rc /= (0::Int))
isRegularFile :: FileStatus -> Bool
isRegularFile stat = unsafePerformIO $
_casm_ ``%r = S_ISREG(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
- return (rc /= 0)
+ return (rc /= (0::Int))
isNamedPipe :: FileStatus -> Bool
isNamedPipe stat = unsafePerformIO $
_casm_ ``%r = S_ISFIFO(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
- return (rc /= 0)
+ return (rc /= (0::Int))
getFileStatus :: FilePath -> IO FileStatus
getFileStatus name = do
path <- packStringIO name
bytes <- allocChars ``sizeof(struct stat)''
rc <- _casm_ ``%r = stat(%0,(struct stat *)%1);'' path bytes
- if rc == 0
+ if rc == (0::Int)
then do
stat <- freeze bytes
return stat
getFdStatus fd = do
bytes <- allocChars ``sizeof(struct stat)''
rc <- _casm_ ``%r = fstat(%0,(struct stat *)%1);'' fd bytes
- if rc == 0
+ if rc == (0::Int)
then do
stat <- freeze bytes
return stat
fileAccess name read write exec = do
path <- packStringIO name
rc <- _ccall_ access path flags
- return (rc == 0)
+ return (rc == (0::Int))
where
flags = I# (word2Int# (read# `or#` write# `or#` exec#))
read# = case (if read then ``R_OK'' else ``0'') of { W# x -> x }
fileExist name = do
path <- packStringIO name
rc <- _ccall_ access path (``F_OK''::Int)
- return (rc == 0)
+ return (rc == (0::Int))
setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name mode = do
path <- packStringIO name
rc <- _ccall_ chmod path mode
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "setFileMode"
setOwnerAndGroup name uid gid = do
path <- packStringIO name
rc <- _ccall_ chown path uid gid
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "setOwnerAndGroup"
rc <- _casm_ ``do {struct utimbuf ub; ub.actime = (time_t) %0;
ub.modtime = (time_t) %1;
%r = utime(%2, &ub);} while(0);'' atime mtime path
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "setFileTimes"
touchFile name = do
path <- packStringIO name
rc <- _ccall_ utime path nullAddr
- if rc == 0
+ if rc == (0::Int)
then return ()
else syserr "touchFile"
pathconf n name = do
path <- packStringIO name
rc <- _ccall_ pathconf path n
- if rc /= -1
+ if rc /= ((-1)::Int)
then return rc
else do
errno <- getErrorCode
if errno == invalidArgument
- then fail (IOError Nothing NoSuchThing "getPathVar" "no such path limit or option")
+ then ioError (IOError Nothing NoSuchThing "getPathVar" "no such path limit or option")
else syserr "PosixFiles.getPathVar"
fpathconf :: Int -> Fd -> IO Limit
fpathconf n fd = do
rc <- _ccall_ fpathconf fd n
- if rc /= -1
+ if rc /= ((-1)::Int)
then return rc
else do
errno <- getErrorCode
if errno == invalidArgument
- then fail (IOError Nothing NoSuchThing "getFileVar" "no such path limit or option")
+ then ioError (IOError Nothing NoSuchThing "getFileVar" "no such path limit or option")
else syserr "getFileVar"
\end{code}
createPipe = do
bytes <- allocChars ``(2*sizeof(int))''
rc <- _casm_ ``%r = pipe((int *)%0);'' bytes
- if rc /= -1
+ if rc /= ((-1)::Int)
then do
rd <- _casm_ ``%r = ((int *)%0)[0];'' bytes
wd <- _casm_ ``%r = ((int *)%0)[1];'' bytes
fdToHandle :: Fd -> IO Handle
fdToHandle fd@(FD# fd#) = do
-- first find out what kind of file desc. this is..
- flags <- _ccall_ fcntl fd (``F_GETFL''::Int) 0
- if flags /= -1
+ flags <- _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int)
+ if flags /= ((-1)::Int)
then do
let
(I# flags#) = flags
| rwH = (ReadWriteHandle, 1)
| otherwise = (ReadHandle, 0)
- fo <- _ccall_ openFd fd flags flush_on_close
+ fo <- _ccall_ openFd fd flags (flush_on_close::Int)
if fo /= nullAddr then do
{-
A distinction is made here between std{Input,Output,Error} Fds
rc <- _ccall_ read fd bytes nbytes
case rc of
-1 -> syserr "fdRead"
- 0 -> fail (IOError Nothing EOF "fdRead" "EOF")
+ 0 -> ioError (IOError Nothing EOF "fdRead" "EOF")
n | n == nbytes -> do
buf <- freeze bytes
s <- unpackNBytesBAIO buf n
fdWrite fd str = do
buf <- packStringIO str
rc <- _ccall_ write fd buf (length str)
- if rc /= -1
+ if rc /= ((-1)::Int)
then return rc
else syserr "fdWrite"
queryFdOption :: Fd -> FdOption -> IO Bool
queryFdOption fd CloseOnExec =
- _ccall_ fcntl fd (``F_GETFD''::Int) 0 >>= \ (I# flags#) ->
+ _ccall_ fcntl fd (``F_GETFD''::Int) (0::Int) >>= \ (I# flags#) ->
if flags# /=# -1# then
return ((int2Word# flags# `and#` fd_cloexec#) `neWord#` int2Word# 0#)
else
where
fd_cloexec# = case (``FD_CLOEXEC'') of { W# x -> x }
queryFdOption fd other =
- _ccall_ fcntl fd (``F_GETFL''::Int) 0 >>= \ (I# flags#) ->
+ _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int) >>= \ (I# flags#) ->
if flags# >=# 0# then
return ((int2Word# flags# `and#` opt#) `neWord#` int2Word# 0#)
else
setFdOption :: Fd -> FdOption -> Bool -> IO ()
setFdOption fd CloseOnExec val = do
- flags <- _ccall_ fcntl fd (``F_GETFD''::Int) 0
- if flags /= -1 then do
+ flags <- _ccall_ fcntl fd (``F_GETFD''::Int) (0::Int)
+ if flags /= ((-1)::Int) then do
rc <- (if val then
_casm_ ``%r = fcntl(%0, F_SETFD, %1 | FD_CLOEXEC);'' fd flags
else do
_casm_ ``%r = fcntl(%0, F_SETFD, %1 & ~FD_CLOEXEC);'' fd flags)
- if rc /= -1
+ if rc /= ((-1)::Int)
then return ()
else fail
else fail
fail = syserr "setFdOption"
setFdOption fd other val = do
- flags <- _ccall_ fcntl fd (``F_GETFL''::Int) 0
- if flags >= 0 then do
+ flags <- _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int)
+ if flags >= (0::Int) then do
rc <- (if val then
_casm_ ``%r = fcntl(%0, F_SETFL, %1 | %2);'' fd flags opt
else do
_casm_ ``%r = fcntl(%0, F_SETFL, %1 & ~(%2));'' fd flags opt)
- if rc /= -1
+ if rc /= ((-1)::Int)
then return ()
else fail
else fail
getLock fd lock = do
flock <- lock2Bytes lock
rc <- _ccall_ fcntl fd (``F_GETLK''::Int) flock
- if rc /= -1
+ if rc /= ((-1)::Int)
then do
result <- bytes2ProcessIDAndLock flock
return (maybeResult result)
fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
fdSeek fd mode offset = do
rc <- _ccall_ lseek fd offset (mode2Int mode)
- if rc /= -1
+ if rc /= ((-1)::Int)
then return rc
else syserr "fdSeek"
#if !defined(cygwin32_TARGET_OS)
getGroups :: IO [GroupID]
getGroups = do
- ngroups <- _ccall_ getgroups 0 nullAddr
+ ngroups <- _ccall_ getgroups (0::Int) nullAddr
words <- allocWords ngroups
ngroups <- _casm_ ``%r = getgroups(%0,(gid_t *)%1);'' ngroups words
- if ngroups /= -1
+ if ngroups /= ((-1)::Int)
then do
arr <- freeze words
return (map (extract arr) [0..(ngroups-1)])
createProcessGroup :: ProcessID -> IO ProcessGroupID
createProcessGroup pid = do
- pgid <- _ccall_ setpgid pid 0
- if pgid == 0
+ pgid <- _ccall_ setpgid pid (0::Int)
+ if pgid == (0::Int)
then return pgid
else syserr "createProcessGroup"
joinProcessGroup :: ProcessGroupID -> IO ()
joinProcessGroup pgid =
- nonzero_error (_ccall_ setpgid 0 pgid) "joinProcessGroupID"
+ nonzero_error (_ccall_ setpgid (0::Int) pgid) "joinProcessGroupID"
setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupID pid pgid =
createSession :: IO ProcessGroupID
createSession = do
pgid <- _ccall_ setsid
- if pgid /= -1
+ if pgid /= ((-1)::Int)
then return pgid
else syserr "createSession"
getSystemID = do
bytes <- allocChars (``sizeof(struct utsname)''::Int)
rc <- _casm_ ``%r = uname((struct utsname *)%0);'' bytes
- if rc /= -1
+ if rc /= ((-1)::Int)
then freeze bytes
else syserr "getSystemID"
epochTime :: IO EpochTime
epochTime = do
secs <- _ccall_ time nullAddr
- if secs /= -1
+ if secs /= ((-1)::Int)
then return secs
else syserr "epochTime"
getProcessTimes = do
bytes <- allocChars (``sizeof(struct tms)''::Int)
elapsed <- _casm_ ``%r = times((struct tms *)%0);'' bytes
- if elapsed /= -1
+ if elapsed /= ((-1)::Int)
then do
times <- freeze bytes
return (elapsed, times)
getControllingTerminalName = do
str <- _ccall_ ctermid nullAddr
if str == nullAddr
- then fail (IOError Nothing NoSuchThing "getControllingTerminalName" "no controlling terminal")
+ then ioError (IOError Nothing NoSuchThing "getControllingTerminalName" "no controlling terminal")
else strcpy str
#endif
then do
err <- try (queryTerminal fd)
either (\err -> syserr "getTerminalName")
- (\succ -> if succ then fail (IOError Nothing NoSuchThing
- "getTerminalName" "no name")
- else fail (IOError Nothing InappropriateType
- "getTerminalName" "not a terminal"))
+ (\succ -> if succ then ioError (IOError Nothing NoSuchThing
+ "getTerminalName" "no name")
+ else ioError (IOError Nothing InappropriateType
+ "getTerminalName" "not a terminal"))
err
else strcpy str
queryTerminal :: Fd -> IO Bool
queryTerminal (FD# fd) = do
rc <- _ccall_ isatty fd
- case rc of
+ case (rc::Int) of
-1 -> syserr "queryTerminal"
0 -> return False
1 -> return True
sysconf :: Int -> IO Limit
sysconf n = do
rc <- _ccall_ sysconf n
- if rc /= -1
+ if rc /= (-1::Int)
then return rc
- else fail (IOError Nothing NoSuchThing
- "getSysVar"
- "no such system limit or option")
+ else ioError (IOError Nothing NoSuchThing
+ "getSysVar"
+ "no such system limit or option")
\end{code}
forkProcess :: IO (Maybe ProcessID)
forkProcess = do
pid <-_ccall_ fork
- case pid of
+ case (pid::Int) of
-1 -> syserr "forkProcess"
0 -> return Nothing
_ -> return (Just pid)
wstat <- allocWords 1
pid <-_casm_ ``%r = waitpid(%0, (int *)%1, %2);'' pid wstat
(waitOptions block stopped)
- case pid of
+ case (pid::Int) of
-1 -> syserr "getProcessStatus"
0 -> return Nothing
_ -> do ps <- decipherWaitStatus wstat
wstat <- allocWords 1
pid <-_casm_ ``%r = waitpid(%0, (int *)%1, %2);'' (-pgid) wstat
(waitOptions block stopped)
- case pid of
+ case (pid::Int) of
-1 -> syserr "getGroupProcessStatus"
0 -> return Nothing
_ -> do ps <- decipherWaitStatus wstat
str <- packStringIO name
str <- _ccall_ getenv str
if str == nullAddr
- then fail (IOError Nothing NoSuchThing
- "getEnvVar" "no such environment variable")
+ then ioError (IOError Nothing NoSuchThing "getEnvVar" "no such environment variable")
else strcpy str
setEnvVar :: String -> String -> IO ()
setStoppedChildFlag :: Bool -> IO Bool
setStoppedChildFlag b = do
- rc <- _casm_ ``%r = nocldstop; nocldstop = %0;'' x
- return (rc == 0)
+ rc <- _casm_ ``%r = nocldstop; nocldstop = %0;'' (x::Int)
+ return (rc == (0::Int))
where
x = case b of {True -> 0; False -> 1}
queryStoppedChildFlag :: IO Bool
queryStoppedChildFlag = do
rc <- _casm_ ``%r = nocldstop;''
- return (rc == 0)
+ return (rc == (0::Int))
data Handler = Default
| Ignore
inSignalSet :: Signal -> SignalSet -> Bool
inSignalSet int sigset = unsafePerformPrimIO $ do
rc <- _casm_ ``%r = sigismember((sigset_t *)%0, %1);'' sigset int
- return (rc == 1)
+ return (rc == (1::Int))
deleteSignal :: Signal -> SignalSet -> SignalSet
deleteSignal int oldset = unsafePerformPrimIO $ do
-> IO Handler -- old handler
#ifdef __PARALLEL_HASKELL__
-installHandler = fail (userError "installHandler: not available for Parallel Haskell")
+installHandler = ioError (userError "installHandler: not available for Parallel Haskell")
#else
installHandler int handler maybe_mask = (
case handler of
_ccall_ stg_sig_catch int sptr mask
) >>= \rc ->
- if rc >= 0 then do
+ if rc >= (0::Int) then do
osptr <- _casm_ ``%r = (StgStablePtr) (%0);'' rc
m <- deRefStablePtr osptr
return (Catch m)
getSignalMask = do
bytes <- allocChars sigSetSize
rc <- _casm_ ``%r = sigprocmask(0, NULL, (sigset_t *)%0);'' bytes
- if rc == 0
+ if rc == (0::Int)
then freeze bytes
else syserr "getSignalMask"
bytes <- allocChars sigSetSize
rc <- _casm_ ``%r = sigprocmask(%0, (sigset_t *)%1, (sigset_t *)%2);''
how sigset bytes
- if rc == 0
+ if rc == (0::Int)
then freeze bytes
else syserr name
getPendingSignals = do
bytes <- allocChars sigSetSize
rc <- _casm_ ``%r = sigpending((sigset_t *)%0);'' bytes
- if rc == 0
+ if rc == (0::Int)
then freeze bytes
else syserr "getPendingSignals"
decipherWaitStatus :: MutableByteArray s x -> IO ProcessStatus
decipherWaitStatus wstat = do
exited <- _casm_ ``%r = WIFEXITED(*(int *)%0);'' wstat
- if exited /= 0
+ if exited /= (0::Int)
then do
exitstatus <- _casm_ ``%r = WEXITSTATUS(*(int *)%0);'' wstat
- if exitstatus == 0
+ if exitstatus == (0::Int)
then return (Exited ExitSuccess)
else return (Exited (ExitFailure exitstatus))
else do
signalled <- _casm_ ``%r = WIFSIGNALED(*(int *)%0);'' wstat
- if signalled /= 0
+ if signalled /= (0::Int)
then do
termsig <- _casm_ ``%r = WTERMSIG(*(int *)%0);'' wstat
return (Terminated termsig)
controlChar termios cc = unsafePerformIO $ do
val <- _casm_ ``%r = ((struct termios *)%0)->c_cc[%1];''
termios (cc2Word cc)
- if val == ``_POSIX_VDISABLE''
+ if val == (``_POSIX_VDISABLE''::Int)
then return Nothing
else return (Just (toEnum val))
getTerminalAttributes (FD# fd) = do
bytes <- allocChars ``sizeof(struct termios)''
rc <- _casm_ ``%r = tcgetattr(%0,(struct termios *)%1);'' fd bytes
- if rc /= -1
+ if rc /= ((-1)::Int)
then freeze bytes
else syserr "getTerminalAttributes"
setTerminalAttributes (FD# fd) termios state = do
rc <- _casm_ ``%r = tcsetattr(%0,%1,(struct termios *)%2);''
fd (state2Int state) termios
- if rc /= -1
+ if rc /= ((-1)::Int)
then return ()
else syserr "setTerminalAttributes"
where
getTerminalProcessGroupID :: Fd -> IO ProcessGroupID
getTerminalProcessGroupID (FD# fd) = do
pgid <- _ccall_ tcgetpgrp fd
- if pgid /= -1
+ if pgid /= ((-1)::Int)
then return pgid
else syserr "getTerminalProcessGroupID"
\begin{code}
syserr :: String -> IO a
-syserr str = fail (IOError Nothing -- ToDo: better
- SystemError
- str
- "")
+syserr str = ioError (IOError Nothing -- ToDo: better
+ SystemError
+ str
+ "")
-- common templates for system calls
projects / ghc-hetmet.git / commitdiff