X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO.hs;h=a7552f5626ee9afc44e8102ad9fff60e814fbff9;hb=43b264ae52debea04f4cd09aa5c5f5135b3a864a;hp=877623a54f9cccb1fe04171cb2fc67973fd12ad6;hpb=1b8d3f8ad5fd95ce07ae044b69676d5373ed4830;p=ghc-base.git diff --git a/System/IO.hs b/System/IO.hs index 877623a..a7552f5 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : System.IO @@ -36,6 +36,7 @@ module System.IO ( -- ** Opening files + withFile, openFile, -- :: FilePath -> IOMode -> IO Handle IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), @@ -57,9 +58,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 @@ -141,9 +145,10 @@ module System.IO ( -- * Binary input and output -#if !defined(__NHC__) + withBinaryFile, openBinaryFile, -- :: FilePath -> IOMode -> IO Handle hSetBinaryMode, -- :: Handle -> Bool -> IO () +#if !defined(__NHC__) hPutBuf, -- :: Handle -> Ptr a -> Int -> IO () hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int #endif @@ -152,7 +157,12 @@ module System.IO ( hGetBufNonBlocking, -- :: Handle -> Ptr a -> Int -> IO Int #endif - module System.IO.Error, + -- * Temporary files + +#ifdef __GLASGOW_HASKELL__ + openTempFile, + openBinaryTempFile, +#endif ) where #ifdef __GLASGOW_HASKELL__ @@ -160,7 +170,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 @@ -170,6 +179,10 @@ import GHC.Show #ifdef __HUGS__ import Hugs.IO import Hugs.IOExts +import Hugs.IORef +import Hugs.Prelude ( throw, Exception(NonTermination) ) +import Control.Exception ( bracket ) +import System.IO.Unsafe ( unsafeInterleaveIO ) #endif #ifdef __NHC__ @@ -198,9 +211,13 @@ 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 + , bracket , IO () , FilePath -- :: String @@ -208,29 +225,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'). @@ -300,12 +298,9 @@ readFile name = openFile name ReadMode >>= hGetContents -- | The computation 'writeFile' @file str@ function writes the string @str@, -- to the file @file@. - -writeFile :: FilePath -> String -> IO () -writeFile name str = do - hdl <- openFile name WriteMode - hPutStr hdl str - hClose hdl +writeFile :: FilePath -> String -> IO () +writeFile f txt = bracket (openFile f WriteMode) hClose + (\hdl -> hPutStr hdl txt) -- | The computation 'appendFile' @file str@ function appends the string @str@, -- to the file @file@. @@ -317,10 +312,8 @@ writeFile name str = do -- > main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]]) appendFile :: FilePath -> String -> IO () -appendFile name str = do - hdl <- openFile name AppendMode - hPutStr hdl str - hClose hdl +appendFile f txt = bracket (openFile f AppendMode) hClose + (\hdl -> hPutStr hdl txt) -- | The 'readLn' function combines 'getLine' and 'readIO'. @@ -339,14 +332,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 @@ -364,19 +358,49 @@ 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__ */ + +-- | @'withFile' name mode act@ opens a file using 'openFile' and passes +-- the resulting handle to the computation @act@. The handle will be +-- closed on exit from 'withFile', whether by normal termination or by +-- raising an exception. +withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r +withFile name mode = bracket (openFile name mode) hClose + +-- | @'withBinaryFile' name mode act@ opens a file using 'openBinaryFile' +-- and passes the resulting handle to the computation @act@. The handle +-- will be closed on exit from 'withBinaryFile', whether by normal +-- termination or by raising an exception. +withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile name mode = bracket (openBinaryFile name mode) hClose -- --------------------------------------------------------------------------- -- 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 @@ -396,4 +420,25 @@ 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'. + +-- ----------------------------------------------------------------------------- +-- Utils + +#ifdef __GLASGOW_HASKELL__ +-- Copied here to avoid recursive dependency with Control.Exception +bracket + :: IO a -- ^ computation to run first (\"acquire resource\") + -> (a -> IO b) -- ^ computation to run last (\"release resource\") + -> (a -> IO c) -- ^ computation to run in-between + -> IO c -- returns the value from the in-between computation +bracket before after thing = + block (do + a <- before + r <- catchException + (unblock (thing a)) + (\e -> do { after a; throw e }) + after a + return r + ) +#endif