-- ** 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
-- fixIO
#ifdef __GLASGOW_HASKELL__
-fixIO :: (a -> IO a) -> IO a
-fixIO m = stToIO (fixST (ioToST . m))
+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