From: malcolm Date: Wed, 9 Oct 2002 17:24:13 +0000 (+0000) Subject: [project @ 2002-10-09 17:24:12 by malcolm] X-Git-Tag: nhc98-1-18-release~819 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5feea6f48f51876033b43bc6012f6f568ebfd397;p=ghc-base.git [project @ 2002-10-09 17:24:12 by malcolm] Add #ifdefs for nhc98. --- diff --git a/System/IO.hs b/System/IO.hs index 1226fcc..c6ba2c9 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -35,7 +35,9 @@ module System.IO ( hGetPosn, -- :: Handle -> IO HandlePosn hSetPosn, -- :: HandlePosn -> IO () hSeek, -- :: Handle -> SeekMode -> Integer -> IO () +#if !defined(__NHC__) hTell, -- :: Handle -> IO Integer +#endif hWaitForInput, -- :: Handle -> Int -> IO Bool hReady, -- :: Handle -> IO Bool hGetChar, -- :: Handle -> IO Char @@ -87,14 +89,14 @@ module System.IO ( readIO, -- :: Read a => String -> IO a readLn, -- :: Read a => IO a -#ifndef __HUGS__ +#if !defined(__HUGS__) && !defined(__NHC__) hPutBuf, -- :: Handle -> Ptr a -> Int -> IO () hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int #endif fixIO, -- :: (a -> IO a) -> IO a -#ifndef __HUGS__ +#if !defined(__HUGS__) && !defined(__NHC__) hSetEcho, -- :: Handle -> Bool -> IO () hGetEcho, -- :: Handle -> IO Bool @@ -119,6 +121,56 @@ import Hugs.IO import Hugs.IOExts #endif +#ifdef __NHC__ +import IO + ( Handle () + , HandlePosn () + , IOMode (ReadMode,WriteMode,AppendMode,ReadWriteMode) + , BufferMode (NoBuffering,LineBuffering,BlockBuffering) + , SeekMode (AbsoluteSeek,RelativeSeek,SeekFromEnd) + , stdin, stdout, stderr + , openFile -- :: FilePath -> IOMode -> IO Handle + , hClose -- :: Handle -> IO () + , hFileSize -- :: Handle -> IO Integer + , hIsEOF -- :: Handle -> IO Bool + , isEOF -- :: IO Bool + , hSetBuffering -- :: Handle -> BufferMode -> IO () + , hGetBuffering -- :: Handle -> IO BufferMode + , hFlush -- :: Handle -> IO () + , hGetPosn -- :: Handle -> IO HandlePosn + , hSetPosn -- :: HandlePosn -> IO () + , hSeek -- :: Handle -> SeekMode -> Integer -> IO () + , hWaitForInput -- :: Handle -> Int -> IO Bool + , hGetChar -- :: Handle -> IO Char + , hGetLine -- :: Handle -> IO [Char] + , hLookAhead -- :: Handle -> IO Char + , hGetContents -- :: Handle -> IO [Char] + , hPutChar -- :: Handle -> Char -> IO () + , hPutStr -- :: Handle -> [Char] -> IO () + , hIsOpen, hIsClosed -- :: Handle -> IO Bool + , hIsReadable, hIsWritable -- :: Handle -> IO Bool + , hIsSeekable -- :: Handle -> IO Bool + , 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) + , bracket -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c + , bracket_ -- :: IO a -> (a -> IO b) -> IO c -> IO c + + , IO () + , FilePath -- :: String + , IOError + , ioError -- :: IOError -> IO a + , userError -- :: String -> IOError + , catch -- :: IO a -> (IOError -> IO a) -> IO a + ) +import NHC.Internal (unsafePerformIO) +#endif + import System.IO.Error -- ----------------------------------------------------------------------------- @@ -199,3 +251,7 @@ hPrint hdl = hPutStrLn hdl . show 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 +#endif diff --git a/System/IO/Error.hs b/System/IO/Error.hs index 2e0d6db..9ac35a0 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -16,14 +16,14 @@ module System.IO.Error ( IOError, -- abstract -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ IOErrorType, -- abstract #endif ioError, -- :: IOError -> IO a userError, -- :: String -> IOError -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ mkIOError, -- :: IOErrorType -> String -> Maybe Handle -- -> Maybe FilePath -> IOError @@ -44,7 +44,7 @@ module System.IO.Error ( isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType, -#endif /* __HUGS__ */ +#endif /* __GLASGOW_HASKELL__ */ isAlreadyExistsError, -- :: IOError -> Bool isDoesNotExistError, @@ -55,7 +55,7 @@ module System.IO.Error ( isPermissionError, isUserError, -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ ioeGetErrorType, -- :: IOError -> IOErrorType #endif ioeGetErrorString, -- :: IOError -> String @@ -76,7 +76,28 @@ import Text.Show import Hugs.IO #endif -#ifndef __HUGS__ +#ifdef __NHC__ +import IO + ( IOError () + , ioError + , userError + , isAlreadyExistsError -- :: IOError -> Bool + , isDoesNotExistError + , isAlreadyInUseError + , isFullError + , isEOFError + , isIllegalOperation + , isPermissionError + , isUserError + , ioeGetErrorString -- :: IOError -> String + , ioeGetHandle -- :: IOError -> Maybe Handle + , ioeGetFileName -- :: IOError -> Maybe FilePath + ) +--import Data.Maybe (fromJust) +--import Control.Monad (MonadPlus(mplus)) +#endif + +#ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- Constructing an IOError @@ -88,6 +109,21 @@ mkIOError t location maybe_hdl maybe_filename = ioe_handle = maybe_hdl, ioe_filename = maybe_filename } +#ifdef __NHC__ +mkIOError EOF location maybe_hdl maybe_filename = + EOFError location (fromJust maybe_hdl) +mkIOError UserError location maybe_hdl maybe_filename = + UserError location "" +mkIOError t location maybe_hdl maybe_filename = + NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t) + where + ioeTypeToInt AlreadyExists = fromEnum EEXIST + ioeTypeToInt NoSuchThing = fromEnum ENOENT + ioeTypeToInt ResourceBusy = fromEnum EBUSY + ioeTypeToInt ResourceExhausted = fromEnum ENOSPC + ioeTypeToInt IllegalOperation = fromEnum EPERM + ioeTypeToInt PermissionDenied = fromEnum EACCES +#endif -- ----------------------------------------------------------------------------- -- IOErrorType @@ -109,6 +145,12 @@ isUserError = isUserErrorType . ioeGetErrorType -- ----------------------------------------------------------------------------- -- IOErrorTypes +#ifdef __NHC__ +data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy + | ResourceExhausted | EOF | IllegalOperation + | PermissionDenied | UserError +#endif + #ifdef __GLASGOW_HASKELL__ alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, eofErrorType, illegalOperationErrorType, @@ -127,7 +169,7 @@ userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, isEOFErrorType, isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool @@ -200,3 +242,14 @@ annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = annotateIOError exc _ _ _ = exc #endif + +#ifdef 0 /*__NHC__*/ +annotateIOError (IOError msg file hdl code) msg' file' hdl' = + IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code +annotateIOError (EOFError msg hdl) msg' file' hdl' = + EOFError (msg++'\n':msg') (hdl`mplus`hdl') +annotateIOError (UserError loc msg) msg' file' hdl' = + UserError loc (msg++'\n':msg') +annotateIOError (PatternError loc) msg' file' hdl' = + PatternError (loc++'\n':msg') +#endif diff --git a/System/IO/Unsafe.hs b/System/IO/Unsafe.hs index 9ace00c..98dfe2b 100644 --- a/System/IO/Unsafe.hs +++ b/System/IO/Unsafe.hs @@ -26,3 +26,10 @@ import GHC.IOBase #ifdef __HUGS__ import Hugs.IOExts #endif + +#ifdef __NHC__ +import NHC.Internal (unsafePerformIO) + +unsafeInterleaveIO :: IO a -> IO a +unsafeInterleaveIO f = let x = unsafePerformIO f in return x +#endif