bump version to 4.3.0.0, added instance MonadPlus STM

[ghc-base.git] / System / IO.hs

diff --git a/System/IO.hs b/System/IO.hs
index ed75bb0..a543f2b 100644 (file)
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -151,6 +151,7 @@ module System.IO (
     hPutBuf,                   -- :: Handle -> Ptr a -> Int -> IO ()
     hGetBuf,                   -- :: Handle -> Ptr a -> Int -> IO Int
 #if !defined(__NHC__) && !defined(__HUGS__)
+    hGetBufSome,               -- :: Handle -> Ptr a -> Int -> IO Int
     hPutBufNonBlocking,        -- :: Handle -> Ptr a -> Int -> IO Int
     hGetBufNonBlocking,        -- :: Handle -> Ptr a -> Int -> IO Int
 #endif
@@ -171,9 +172,9 @@ module System.IO (
     --
     -- The default 'TextEncoding' is the same as the default encoding
     -- on your system, which is also available as 'localeEncoding'.
-    -- (GHC note: on Windows, currently 'localeEncoding' is always
-    -- 'latin1'; there is no support for encoding and decoding using
-    -- the ANSI code page).
+    -- (GHC note: on Windows, we currently do not support double-byte
+    -- encodings; if the console\'s code page is unsupported, then
+    -- 'localeEncoding' will be 'latin1'.)
     --
     -- Encoding and decoding errors are always detected and reported,
     -- except during lazy I/O ('hGetContents', 'getContents', and
@@ -234,10 +235,13 @@ import System.Posix.Types
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
+import GHC.Real
 import GHC.IO hiding ( onException )
 import GHC.IO.IOMode
 import GHC.IO.Handle.FD
+import qualified GHC.IO.FD as FD
 import GHC.IO.Handle
+import GHC.IO.Handle.Text ( hGetBufSome )
 import GHC.IORef
 import GHC.IO.Exception ( userError )
 import GHC.IO.Encoding
@@ -468,6 +472,8 @@ fixIO k = do
 -- Assume a unix platform, where text and binary I/O are identical.
 openBinaryFile = openFile
 hSetBinaryMode _ _ = return ()
+
+type CMode = Int
 #endif
 
 -- | The function creates a temporary file in ReadWrite mode.
@@ -543,10 +549,10 @@ openTempFile' loc tmp_dir template binary mode = do
     oflags = oflags1 .|. binary_flags
 #endif
 
-#ifdef __NHC__
+#if defined(__NHC__)
     findTempName x = do h <- openFile filepath ReadWriteMode
                         return (filepath, h)
-#else
+#elif defined(__GLASGOW_HASKELL__)
     findTempName x = do
       fd <- withFilePath filepath $ \ f ->
               c_open f oflags mode
@@ -557,12 +563,20 @@ openTempFile' loc tmp_dir template binary mode = do
            then findTempName (x+1)
            else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
        else do
-         -- XXX We want to tell fdToHandle what the filepath is,
-         -- as any exceptions etc will only be able to report the
-         -- fd currently
+
+         (fD,fd_type) <- FD.mkFD (fromIntegral fd) ReadWriteMode Nothing{-no stat-}
+                              False{-is_socket-} 
+                              True{-is_nonblock-}
+
+         h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-}
+                           (Just localeEncoding)
+
+         return (filepath, h)
+#else
          h <- fdToHandle fd `onException` c_close fd
          return (filepath, h)
 #endif
+
       where
         filename        = prefix ++ show x ++ suffix
         filepath        = tmp_dir `combine` filename