X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FFD.hs;h=17362dc9dd41bdb5f85e79e844ed6fa8730f3d1c;hb=40fe562f6d01f6076bf00a267dd24f57b45a1933;hp=d873a4e09859c50e3b70dbb06f663b86d7862348;hpb=ec7d7ba5e16fddc419a5f0da82a66764f5537c55;p=ghc-base.git

diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
index d873a4e..17362dc 100644
--- a/GHC/IO/FD.hs
+++ b/GHC/IO/FD.hs
@@ -281,13 +281,15 @@ close fd =
 #ifndef mingw32_HOST_OS
   (flip finally) (release fd) $ do
 #endif
-  throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
+  let closer realFd =
+        throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
 #ifdef mingw32_HOST_OS
-    if fdIsSocket fd then
-       c_closesocket (fdFD fd)
-    else
+        if fdIsSocket fd then
+          c_closesocket (fromIntegral realFd)
+        else
 #endif
-       c_close (fdFD fd)
+          c_close (fromIntegral realFd)
+  closeFd closer (fromIntegral (fdFD fd))
 
 release :: FD -> IO ()
 #ifdef mingw32_HOST_OS