X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FFD.hs;h=b5392d477d1df5ca57b9997d2dbd25eb7c9bc613;hb=41e8fba828acbae1751628af50849f5352b27873;hp=3ba155ed22055f348c99ffdf46a7cdc9c70c27cb;hpb=b22112520b01c4906eebd0b6894d4bf2665c11e2;p=ghc-base.git diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs index 3ba155e..b5392d4 100644 --- a/GHC/IO/FD.hs +++ b/GHC/IO/FD.hs @@ -1,6 +1,13 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns -fno-warn-identities #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , BangPatterns + , ForeignFunctionInterface + , DeriveDataTypeable + #-} +{-# OPTIONS_GHC -fno-warn-identities #-} -- Whether there are identities depends on the platform {-# OPTIONS_HADDOCK hide #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.IO.FD @@ -99,8 +106,15 @@ instance GHC.IO.Device.IODevice FD where dup = dup dup2 = dup2 +-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is +-- taken from the value of BUFSIZ on the current platform. This value +-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192 +-- on Linux. So let's just use a decent size on every platform: +dEFAULT_FD_BUFFER_SIZE :: Int +dEFAULT_FD_BUFFER_SIZE = 8096 + instance BufferedIO FD where - newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state + newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state fillReadBuffer fd buf = readBuf' fd buf fillReadBuffer0 fd buf = readBufNonBlocking fd buf flushWriteBuffer fd buf = writeBuf' fd buf @@ -279,17 +293,17 @@ stderr = stdFD 2 close :: FD -> IO () close fd = #ifndef mingw32_HOST_OS - (flip finally) (release fd) $ do + (flip finally) (release fd) $ #endif - let closer realFd = - throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $ + do let closer realFd = + throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $ #ifdef mingw32_HOST_OS - if fdIsSocket fd then - c_closesocket (fromIntegral realFd) - else + if fdIsSocket fd then + c_closesocket (fromIntegral realFd) + else #endif - c_close (fromIntegral realFd) - closeFdWith closer (fromIntegral (fdFD fd)) + c_close (fromIntegral realFd) + closeFdWith closer (fromIntegral (fdFD fd)) release :: FD -> IO () #ifdef mingw32_HOST_OS