[project @ 2000-04-14 16:16:13 by rrt]

[ghc-hetmet.git] / ghc / lib / std / PrelIOBase.lhs

diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index bf7a64f..d037275 100644 (file)
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.15 1999/11/26 16:26:32 simonmar Exp $
+% $Id: PrelIOBase.lhs,v 1.23 2000/04/14 15:28:24 rrt Exp $
 % 
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
@@ -12,6 +12,7 @@ concretely; the @IO@ module itself exports abstractly.
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 #include "cbits/stgerror.h"
+#include "config.h"
 
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelIOBase where
@@ -21,10 +22,9 @@ import {-# SOURCE #-} PrelErr ( error )
 import PrelST
 import PrelBase
 import {-# SOURCE #-} PrelException ( ioError )
-import PrelST    ( ST(..), STret(..) )
 import PrelMaybe  ( Maybe(..) )
 import PrelAddr          ( Addr(..), nullAddr )
-import PrelPack   ( unpackCString )
+import PrelPack ( unpackCString )
 import PrelShow
 
 #if !defined(__CONCURRENT_HASKELL__)
@@ -55,6 +55,23 @@ The IO Monad is just an instance of the ST monad, where the state is
 the real world.  We use the exception mechanism (in PrelException) to
 implement IO exceptions.
 
+NOTE: The IO representation is deeply wired in to various parts of the
+system.  The following list may or may not be exhaustive:
+
+Compiler  - types of various primitives in PrimOp.lhs
+
+RTS      - forceIO (StgMiscClosures.hc)
+         - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast 
+           (Exceptions.hc)
+         - raiseAsync (Schedule.c)
+
+Prelude   - PrelIOBase.lhs, and several other places including
+           PrelException.lhs.
+
+Libraries - parts of hslibs/lang.
+
+--SDM
+
 \begin{code}
 #ifndef __HUGS__
 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
@@ -70,15 +87,11 @@ instance  Monad IO  where
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
     m >> k      =  m >>= \ _ -> k
-    return x   = IO $ \ s -> (# s, x #)
+    return x   = returnIO x
 
     m >>= k     = bindIO m k
     fail s     = error s -- not ioError?
 
-    -- not required but worth having around
-fixIO          :: (a -> IO a) -> IO a
-fixIO m         = stToIO (fixST (ioToST . m))
-
 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
 
@@ -88,6 +101,8 @@ bindIO (IO m) k = IO ( \ s ->
     (# new_s, a #) -> unIO (k a) new_s
   )
 
+returnIO :: a -> IO a
+returnIO x = IO (\ s -> (# s, x #))
 #endif
 \end{code}
 
@@ -161,7 +176,7 @@ data IOErrorType
   | TimeExpired          | UnsatisfiedConstraints
   | UnsupportedOperation | UserError
   | EOF
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
   | ComError Int           -- HRESULT
 #endif
   deriving (Eq)
@@ -189,7 +204,7 @@ instance Show IOErrorType where
       UserError         -> "failed"
       UnsupportedOperation -> "unsupported operation"
       EOF              -> "end of file"
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
       ComError _       -> "COM error"
 #endif
 
@@ -419,8 +434,9 @@ data Handle__
       haFO__         :: FILE_OBJECT,
       haType__        :: Handle__Type,
       haBufferMode__  :: BufferMode,
-      haFilePath__    :: FilePath
-    }      
+      haFilePath__    :: FilePath,
+      haBuffers__     :: [Addr]
+    }
 
 {-
   Internally, we classify handles as being one