-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
--- Stability : provisional
+-- Stability : stable
-- Portability : portable
--
-- The standard IO library.
-- ** Terminal operations
-#if !defined(__HUGS__) && !defined(__NHC__)
+#if !defined(__NHC__)
hIsTerminalDevice, -- :: Handle -> IO Bool
hSetEcho, -- :: Handle -> Bool -> IO ()
#if !defined(__NHC__)
openBinaryFile, -- :: FilePath -> IOMode -> IO Handle
-#endif
-
-#if !defined(__HUGS__) && !defined(__NHC__)
hSetBinaryMode, -- :: Handle -> Bool -> IO ()
hPutBuf, -- :: Handle -> Ptr a -> Int -> IO ()
hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int
#endif
+#if !defined(__NHC__) && !defined(__HUGS__)
+ hPutBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int
+ hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int
+#endif
module System.IO.Error,
) where
#ifdef __HUGS__
import Hugs.IO
import Hugs.IOExts
+import Hugs.IORef
+import Hugs.Prelude ( throw, Exception(NonTermination) )
+import System.IO.Unsafe ( unsafeInterleaveIO )
#endif
#ifdef __NHC__
, IO ()
, FilePath -- :: String
)
-import NHC.Internal (unsafePerformIO)
+import NHC.IOExtras (fixIO)
#endif
import System.IO.Error (
putStr :: String -> IO ()
putStr s = hPutStr stdout s
--- | The same as 'putStrLn', but adds a newline character.
+-- | The same as 'putStr', but adds a newline character.
putStrLn :: String -> IO ()
putStrLn s = do putStr s
-- ---------------------------------------------------------------------------
-- fixIO
-#ifdef __GLASGOW_HASKELL__
-fixIO :: (a -> IO a) -> IO a
-fixIO m = stToIO (fixST (ioToST . m))
-#endif
-#ifdef __NHC__
-fixIO :: (a -> IO a) -> IO a
-fixIO f = let x = unsafePerformIO (f x) in return x
+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
+fixIO :: (a -> IO a) -> IO a
+fixIO k = do
+ ref <- newIORef (throw NonTermination)
+ ans <- unsafeInterleaveIO (readIORef ref)
+ result <- k ans
+ writeIORef ref result
+ return result
+
+-- NOTE: we do our own explicit black holing here, because GHC's lazy
+-- blackholing isn't enough. In an infinite loop, GHC may run the IO
+-- computation a few times before it notices the loop, which is wrong.
#endif
-- $locking