Add a more efficient Data.List.foldl' for GHC (from GHC's utils/Util.lhs)

[ghc-base.git] / GHC / Handle.hs

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index cb6d5de..261c81c 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -55,7 +55,6 @@ module GHC.Handle (
 
  ) where
 
-import System.Directory.Internals
 import Control.Monad
 import Data.Bits
 import Data.Maybe
@@ -590,7 +589,7 @@ readRawBufferNoBlock loc fd is_nonblock buf off len
                                 else return 0
        -- XXX see note [nonblock]
  where
-   do_read call = throwErrnoIfMinus1RetryMayBlock loc call (return 0)
+   do_read call = throwErrnoIfMinus1RetryOnBlock loc call (return 0)
    unsafe_read  = do_read (read_rawBuffer fd buf off len)
    safe_read    = do_read (safe_read_rawBuffer fd buf off len)
 
@@ -599,8 +598,9 @@ writeRawBuffer loc fd is_nonblock buf off len
   | is_nonblock = unsafe_write
   | threaded    = safe_write
   | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
-                     if r /= 0 then safe_write
-                                else return 0
+                     if r /= 0 
+                        then safe_write
+                        else do threadWaitWrite (fromIntegral fd); unsafe_write
   where  
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
                        (threadWaitWrite (fromIntegral fd)) 
@@ -612,8 +612,9 @@ writeRawBufferPtr loc fd is_nonblock buf off len
   | is_nonblock = unsafe_write
   | threaded    = safe_write
   | otherwise   = do r <- fdReady (fromIntegral fd) 1 0 False
-                     if r /= 0 then safe_write
-                                else return 0
+                     if r /= 0 
+                        then safe_write
+                        else do threadWaitWrite (fromIntegral fd); unsafe_write
   where
     do_write call = throwErrnoIfMinus1RetryMayBlock loc call
                        (threadWaitWrite (fromIntegral fd)) 
@@ -945,8 +946,14 @@ openTempFile' loc tmp_dir template binary = do
         return (filepath, h)
       where
         filename        = prefix ++ show x ++ suffix
-        filepath        = tmp_dir `joinFileName` filename
+        filepath        = tmp_dir ++ [pathSeparator] ++ filename
 
+pathSeparator :: Char
+#ifdef mingw32_HOST_OS
+pathSeparator = '\\'
+#else
+pathSeparator = '/'
+#endif
 
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT