[project @ 2005-11-11 12:01:58 by simonmar]
[haskell-directory.git] / System / IO.hs
index f3e0212..5fd8ac5 100644 (file)
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.IO
@@ -6,7 +6,7 @@
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
+-- Stability   :  stable
 -- Portability :  portable
 --
 -- The standard IO library.
@@ -57,9 +57,12 @@ module System.IO (
 
     -- * Operations on handles
 
-    -- ** Determining the size of a file
+    -- ** Determining and changing the size of a file
 
     hFileSize,                -- :: Handle -> IO Integer
+#ifdef __GLASGOW_HASKELL__
+    hSetFileSize,              -- :: Handle -> Integer -> IO ()
+#endif
 
     -- ** Detecting the end of input
 
@@ -93,7 +96,7 @@ module System.IO (
 
     -- ** Terminal operations
 
-#if !defined(__HUGS__) && !defined(__NHC__)
+#if !defined(__NHC__)
     hIsTerminalDevice,         -- :: Handle -> IO Bool
 
     hSetEcho,                  -- :: Handle -> Bool -> IO ()
@@ -141,17 +144,23 @@ module System.IO (
 
     -- * Binary input and output
 
-#if !defined(__NHC__)
     openBinaryFile,           -- :: FilePath -> IOMode -> IO Handle
-#endif
-
-#if !defined(__HUGS__) && !defined(__NHC__)
     hSetBinaryMode,           -- :: Handle -> Bool -> IO ()
+#if !defined(__NHC__)
     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
+
+    -- * Temporary files
 
-    module System.IO.Error,
+#ifdef __GLASGOW_HASKELL__
+    openTempFile,
+    openBinaryTempFile,
+#endif
   ) where
 
 #ifdef __GLASGOW_HASKELL__
@@ -159,7 +168,6 @@ import GHC.Base
 import GHC.IOBase      -- Together these four Prelude modules define
 import GHC.Handle      -- all the stuff exported by IO for the GHC version
 import GHC.IO
-import GHC.ST          ( fixST )
 import GHC.Exception
 import GHC.Num
 import GHC.Read
@@ -169,6 +177,9 @@ import GHC.Show
 #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__
@@ -197,6 +208,9 @@ import IO
   , hGetContents              -- :: Handle -> IO [Char]
   , hPutChar                  -- :: Handle -> Char -> IO ()
   , hPutStr                   -- :: Handle -> [Char] -> IO ()
+  , hPutStrLn                 -- :: Handle -> [Char] -> IO ()
+  , hPrint                    -- :: Handle -> [Char] -> IO ()
+  , hReady                    -- :: Handle -> [Char] -> IO ()
   , hIsOpen, hIsClosed        -- :: Handle -> IO Bool
   , hIsReadable, hIsWritable  -- :: Handle -> IO Bool
   , hIsSeekable               -- :: Handle -> IO Bool
@@ -207,29 +221,10 @@ import IO
 import NHC.IOExtras (fixIO)
 #endif
 
-import System.IO.Error (
-    isAlreadyExistsError, isDoesNotExistError,  -- :: IOError -> Bool
-    isAlreadyInUseError, isFullError, 
-    isEOFError, isIllegalOperation, 
-    isPermissionError, isUserError, 
-    ioeGetErrorString,         -- :: IOError -> String
-    ioeGetHandle,              -- :: IOError -> Maybe Handle
-    ioeGetFileName,            -- :: IOError -> Maybe FilePath
-    try,                       -- :: IO a -> IO (Either IOError a)
-    -- re-exports of Prelude names
-    IOError,
-    ioError,                   -- :: IOError -> IO a
-    userError,                 -- :: String  -> IOError
-    catch                      -- :: IO a    -> (IOError -> IO a) -> IO a
-  )
-
 -- -----------------------------------------------------------------------------
 -- Standard IO
 
-#ifndef __HUGS__
+#ifdef __GLASGOW_HASKELL__
 -- | Write a character to the standard output device
 -- (same as 'hPutChar' 'stdout').
 
@@ -242,7 +237,7 @@ putChar c       =  hPutChar stdout c
 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
@@ -338,14 +333,15 @@ readIO s        =  case (do { (x,t) <- reads s ;
                        [x]    -> return x
                        []     -> ioError (userError "Prelude.readIO: no parse")
                        _      -> ioError (userError "Prelude.readIO: ambiguous parse")
-#endif  /* __HUGS__ */
+#endif  /* __GLASGOW_HASKELL__ */
 
+#ifndef __NHC__
 -- | Computation 'hReady' @hdl@ indicates whether at least one item is
 -- available for input from handle @hdl@.
 -- 
 -- This operation may fail with:
 --
---  * 'isEOFError' if the end of file has been reached.
+--  * 'System.IO.Error.isEOFError' if the end of file has been reached.
 
 hReady         :: Handle -> IO Bool
 hReady h       =  hWaitForInput h 0
@@ -363,19 +359,35 @@ hPutStrLn hndl str = do
 --
 -- This operation may fail with:
 --
---  * 'isFullError' if the device is full; or
+--  * 'System.IO.Error.isFullError' if the device is full; or
 --
---  * 'isPermissionError' if another system resource limit would be exceeded.
+--  * 'System.IO.Error.isPermissionError' if another system resource limit would be exceeded.
 
 hPrint         :: Show a => Handle -> a -> IO ()
 hPrint hdl     =  hPutStrLn hdl . show
+#endif /* !__NHC__ */
 
 -- ---------------------------------------------------------------------------
 -- fixIO
 
-#ifdef __GLASGOW_HASKELL__
-fixIO          :: (a -> IO a) -> IO a
-fixIO m         = stToIO (fixST (ioToST . m))
+#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
+
+#if defined(__NHC__)
+-- Assume a unix platform, where text and binary I/O are identical.
+openBinaryFile = openFile
+hSetBinaryMode _ _ = return ()
 #endif
 
 -- $locking
@@ -395,4 +407,4 @@ fixIO m         = stToIO (fixST (ioToST . m))
 -- the file until the entire contents of the file have been consumed.
 -- It follows that an attempt to write to a file (using 'writeFile', for
 -- example) that was earlier opened by 'readFile' will usually result in
--- failure with 'isAlreadyInUseError'.
+-- failure with 'System.IO.Error.isAlreadyInUseError'.