X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FC%2FError.hs;h=8d149c1dc6bec0d4348d1fbefdc5c0cf26e6de6c;hb=566d4ea2e4434bf0bedfaa518c31bca42959855d;hp=df67672a2bc92d2e2b1abcb75ee3893c79c72c3c;hpb=0a1f2416da32b71beed33f9bc8c49e35e7f69b58;p=ghc-base.git

diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs
index df67672..8d149c1 100644
--- a/Foreign/C/Error.hs
+++ b/Foreign/C/Error.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Foreign.C.Error
@@ -101,20 +101,6 @@ module Foreign.C.Error (
 #include "HsBaseConfig.h"
 #endif
 
--- system dependent imports
--- ------------------------
-
--- GHC allows us to get at the guts inside IO errors/exceptions
---
-#if __GLASGOW_HASKELL__
-import GHC.IOBase (IOException(..), IOErrorType(..))
-#endif /* __GLASGOW_HASKELL__ */
-
-
--- regular imports
--- ---------------
-
-import Foreign.Storable
 import Foreign.Ptr
 import Foreign.C.Types
 import Foreign.C.String
@@ -122,7 +108,9 @@ import Foreign.Marshal.Error    ( void )
 import Data.Maybe
 
 #if __GLASGOW_HASKELL__
-import GHC.IOBase
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Handle.Types
 import GHC.Num
 import GHC.Base
 #elif __HUGS__
@@ -132,6 +120,7 @@ import System.IO.Unsafe         ( unsafePerformIO )
 import System.IO                ( Handle )
 import System.IO.Error          ( IOError, ioError )
 import System.IO.Unsafe         ( unsafePerformIO )
+import Foreign.Storable         ( Storable(poke,peek) )
 #endif
 
 #ifdef __HUGS__
@@ -369,8 +358,9 @@ throwErrnoIfRetry pred loc f  =
           else throwErrno loc
       else return res
 
--- | as 'throwErrnoIfRetry', but checks for operations that would block and
--- executes an alternative action before retrying in that case.
+-- | as 'throwErrnoIfRetry', but additionally if the operation 
+-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative
+-- action is executed before retrying.
 --
 throwErrnoIfRetryMayBlock
                 :: (a -> Bool)  -- ^ predicate to apply to the result value
@@ -389,7 +379,8 @@ throwErrnoIfRetryMayBlock pred loc f on_block  =
         if err == eINTR
           then throwErrnoIfRetryMayBlock pred loc f on_block
           else if err == eWOULDBLOCK || err == eAGAIN
-                 then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block
+                 then do _ <- on_block
+                         throwErrnoIfRetryMayBlock pred loc f on_block
                  else throwErrno loc
       else return res
 
@@ -499,7 +490,7 @@ throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
 -- conversion of an "errno" value into IO error
 -- --------------------------------------------
 
--- | Construct a Haskell 98 I\/O error based on the given 'Errno' value.
+-- | Construct an 'IOError' based on the given 'Errno' value.
 -- The optional information can be used to improve the accuracy of
 -- error messages.
 --
@@ -511,8 +502,9 @@ errnoToIOError  :: String       -- ^ the location where the error occurred
 errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
     str <- strerror errno >>= peekCString
 #if __GLASGOW_HASKELL__
-    return (IOError maybeHdl errType loc str maybeName)
+    return (IOError maybeHdl errType loc str (Just errno') maybeName)
     where
+    Errno errno' = errno
     errType
         | errno == eOK             = OtherError
         | errno == e2BIG           = ResourceExhausted