[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 (file)
--- 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 (file)
--- 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 (file)
--- 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