[project @ 2000-04-14 16:16:13 by rrt]
[ghc-hetmet.git] / ghc / lib / std / PrelIOBase.lhs
index e39edfc..d037275 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
 % -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.16 1999/12/03 16:17:42 simonmar Exp $
+% $Id: PrelIOBase.lhs,v 1.23 2000/04/14 15:28:24 rrt Exp $
 % 
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
 % 
 % (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"
 \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
 
 #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
 import PrelBase
 import {-# SOURCE #-} PrelException ( ioError )
-import PrelST    ( ST(..), STret(..) )
 import PrelMaybe  ( Maybe(..) )
 import PrelAddr          ( Addr(..), nullAddr )
 import PrelMaybe  ( Maybe(..) )
 import PrelAddr          ( Addr(..), nullAddr )
-import PrelPack   ( unpackCString )
+import PrelPack ( unpackCString )
 import PrelShow
 
 #if !defined(__CONCURRENT_HASKELL__)
 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.
 
 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 #))
 \begin{code}
 #ifndef __HUGS__
 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
@@ -70,7 +87,7 @@ instance  Monad IO  where
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
     m >> k      =  m >>= \ _ -> k
     {-# 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?
 
     m >>= k     = bindIO m k
     fail s     = error s -- not ioError?
@@ -84,6 +101,8 @@ bindIO (IO m) k = IO ( \ s ->
     (# new_s, a #) -> unIO (k a) new_s
   )
 
     (# new_s, a #) -> unIO (k a) new_s
   )
 
+returnIO :: a -> IO a
+returnIO x = IO (\ s -> (# s, x #))
 #endif
 \end{code}
 
 #endif
 \end{code}
 
@@ -157,7 +176,7 @@ data IOErrorType
   | TimeExpired          | UnsatisfiedConstraints
   | UnsupportedOperation | UserError
   | EOF
   | TimeExpired          | UnsatisfiedConstraints
   | UnsupportedOperation | UserError
   | EOF
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
   | ComError Int           -- HRESULT
 #endif
   deriving (Eq)
   | ComError Int           -- HRESULT
 #endif
   deriving (Eq)
@@ -185,7 +204,7 @@ instance Show IOErrorType where
       UserError         -> "failed"
       UnsupportedOperation -> "unsupported operation"
       EOF              -> "end of file"
       UserError         -> "failed"
       UnsupportedOperation -> "unsupported operation"
       EOF              -> "end of file"
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
       ComError _       -> "COM error"
 #endif
 
       ComError _       -> "COM error"
 #endif
 
@@ -415,8 +434,9 @@ data Handle__
       haFO__         :: FILE_OBJECT,
       haType__        :: Handle__Type,
       haBufferMode__  :: BufferMode,
       haFO__         :: FILE_OBJECT,
       haType__        :: Handle__Type,
       haBufferMode__  :: BufferMode,
-      haFilePath__    :: FilePath
-    }      
+      haFilePath__    :: FilePath,
+      haBuffers__     :: [Addr]
+    }
 
 {-
   Internally, we classify handles as being one
 
 {-
   Internally, we classify handles as being one