projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Tweak the BufferedIO class to enable a memory-mapped file implementation
[ghc-base.git]
/
GHC
/
IO
/
FD.hs
diff --git
a/GHC/IO/FD.hs
b/GHC/IO/FD.hs
index
8e52584
..
98eeeab
100644
(file)
--- a/
GHC/IO/FD.hs
+++ b/
GHC/IO/FD.hs
@@
-117,7
+117,7
@@
readBuf' fd buf = do
#endif
return (r,buf')
#endif
return (r,buf')
-writeBuf' :: FD -> Buffer Word8 -> IO ()
+writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)
writeBuf' fd buf = do
#ifdef DEBUG_DUMP
puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
writeBuf' fd buf = do
#ifdef DEBUG_DUMP
puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
@@
-165,7
+165,8
@@
openFile filepath iomode =
(fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}
False{-not a socket-}
True{-is non-blocking-}
(fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}
False{-not a socket-}
True{-is non-blocking-}
- `catchAny` \e -> do c_close fd; throwIO e
+ `catchAny` \e -> do _ <- c_close fd
+ throwIO e
#ifndef mingw32_HOST_OS
-- we want to truncate() if this is an open in WriteMode, but only
#ifndef mingw32_HOST_OS
-- we want to truncate() if this is an open in WriteMode, but only
@@
-218,7
+219,7
@@
mkFD fd iomode mb_stat is_socket is_nonblock = do
_ -> True
#ifdef mingw32_HOST_OS
_ -> True
#ifdef mingw32_HOST_OS
- setmode fd True -- unconditionally set binary mode
+ _ <- setmode fd True -- unconditionally set binary mode
let _ = (dev,ino,write) -- warning suppression
#endif
let _ = (dev,ino,write) -- warning suppression
#endif
@@
-292,12
+293,12
@@
close fd =
c_close (fdFD fd)
release :: FD -> IO ()
c_close (fdFD fd)
release :: FD -> IO ()
-release fd = do
-#ifndef mingw32_HOST_OS
- unlockFile (fdFD fd)
+#ifdef mingw32_HOST_OS
+release _ = return ()
+#else
+release fd = do _ <- unlockFile (fdFD fd)
+ return ()
#endif
#endif
- let _ = fd -- warning suppression
- return ()
#ifdef mingw32_HOST_OS
foreign import stdcall unsafe "HsBase.h closesocket"
#ifdef mingw32_HOST_OS
foreign import stdcall unsafe "HsBase.h closesocket"
@@
-311,9
+312,8
@@
isSeekable fd = do
seek :: FD -> SeekMode -> Integer -> IO ()
seek fd mode off = do
seek :: FD -> SeekMode -> Integer -> IO ()
seek fd mode off = do
- throwErrnoIfMinus1Retry "seek" $
+ throwErrnoIfMinus1Retry_ "seek" $
c_lseek (fdFD fd) (fromIntegral off) seektype
c_lseek (fdFD fd) (fromIntegral off) seektype
- return ()
where
seektype :: CInt
seektype = case mode of
where
seektype :: CInt
seektype = case mode of
@@
-332,9
+332,8
@@
getSize fd = fdFileSize (fdFD fd)
setSize :: FD -> Integer -> IO ()
setSize fd size = do
setSize :: FD -> Integer -> IO ()
setSize fd size = do
- throwErrnoIf (/=0) "GHC.IO.FD.setSize" $
+ throwErrnoIf_ (/=0) "GHC.IO.FD.setSize" $
c_ftruncate (fdFD fd) (fromIntegral size)
c_ftruncate (fdFD fd) (fromIntegral size)
- return ()
devType :: FD -> IO IODeviceType
devType fd = do (ty,_,_) <- fdStat (fdFD fd); return ty
devType :: FD -> IO IODeviceType
devType fd = do (ty,_,_) <- fdStat (fdFD fd); return ty
@@
-347,7
+346,7
@@
dup fd = do
dup2 :: FD -> FD -> IO FD
dup2 fd fdto = do
-- Windows' dup2 does not return the new descriptor, unlike Unix
dup2 :: FD -> FD -> IO FD
dup2 fd fdto = do
-- Windows' dup2 does not return the new descriptor, unlike Unix
- throwErrnoIfMinus1 "GHC.IO.FD.dup2" $
+ throwErrnoIfMinus1_ "GHC.IO.FD.dup2" $
c_dup2 (fdFD fd) (fdFD fdto)
return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD
c_dup2 (fdFD fd) (fdFD fdto)
return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD