X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Flib%2Fstd%2FPrelIOBase.lhs;h=ef862df2b0ebc7adc029b8e735eb8d7d10f26607;hb=9746e23a7eec9cce118f0f5e69aa95168143a7d7;hp=351f27116b845a7087fbde8cdb7d89286daa6cd9;hpb=7a8055296b92b3aae1288f8b627292f65f91941f;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index 351f271..ef862df 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.40 2001/05/22 19:25:49 qrczak Exp $
+% $Id: PrelIOBase.lhs,v 1.45 2001/11/26 20:04:00 sof Exp $
 % 
 % (c) The University of Glasgow, 1994-2001
 %
@@ -9,8 +9,6 @@
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
-#include "config.h"
-
 module PrelIOBase where
 
 import PrelST
@@ -151,12 +149,16 @@ type FD = Int -- XXX ToDo: should be CInt
 
 data Handle__
   = Handle__ {
-      haFD	    :: !FD,
-      haType        :: HandleType,
-      haBufferMode  :: BufferMode,
-      haFilePath    :: FilePath,
-      haBuffer	    :: !(IORef Buffer),
-      haBuffers     :: !(IORef BufferList)
+      haFD	    :: !FD,		     -- file descriptor
+      haType        :: HandleType,	     -- type (read/write/append etc.)
+      haIsBin       :: Bool,		     -- binary mode?
+      haIsStream    :: Bool,		     -- is this a stream handle?
+      haBufferMode  :: BufferMode,	     -- buffer contains read/write data?
+      haFilePath    :: FilePath,	     -- file name, possibly
+      haBuffer	    :: !(IORef Buffer),	     -- the current buffer
+      haBuffers     :: !(IORef BufferList),  -- spare buffers
+      haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
+					     -- duplex handle.
     }
 
 -- ---------------------------------------------------------------------------
@@ -234,7 +236,15 @@ data HandleType
  | WriteHandle
  | AppendHandle
  | ReadWriteHandle
- | ReadSideHandle  !(MVar Handle__)	-- read side of a duplex handle
+
+isReadableHandleType ReadHandle         = True
+isReadableHandleType ReadWriteHandle    = True
+isReadableHandleType _	       	        = False
+
+isWritableHandleType AppendHandle    = True
+isWritableHandleType WriteHandle     = True
+isWritableHandleType ReadWriteHandle = True
+isWritableHandleType _	       	     = False
 
 -- File names are specified using @FilePath@, a OS-dependent
 -- string that (hopefully, I guess) maps to an accessible file/object.
@@ -322,13 +332,12 @@ instance Show HandleType where
       WriteHandle       -> showString "writable"
       AppendHandle      -> showString "writable (append)"
       ReadWriteHandle   -> showString "read-writable"
-      ReadSideHandle _  -> showString "read-writable (duplex)"
 
 instance Show Handle where 
-  showsPrec p (FileHandle   h)   = showHandle p h
-  showsPrec p (DuplexHandle h _) = showHandle p h
+  showsPrec p (FileHandle   h)   = showHandle p h False
+  showsPrec p (DuplexHandle _ h) = showHandle p h True
    
-showHandle p h =
+showHandle p h duplex =
     let
      -- (Big) SIGH: unfolded defn of takeMVar to avoid
      -- an (oh-so) unfortunate module loop with PrelConc.
@@ -337,13 +346,18 @@ showHandle p h =
 	     case takeMVar# h# s#   of { (# s2# , r #) -> 
 	     case putMVar# h# r s2# of { s3# ->
 	     (# s3#, r #) }}})
+
+     showType | duplex = showString "duplex (read-write)"
+	      | otherwise = showsPrec p (haType hdl_)
     in
     showChar '{' . 
     showHdl (haType hdl_) 
 	    (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
-	     showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
+	     showString "type=" . showType . showChar ',' .
+	     showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
 	     showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
    where
+
     showHdl :: HandleType -> ShowS -> ShowS
     showHdl ht cont = 
        case ht of
@@ -507,10 +521,13 @@ data IOErrorType
   | TimeExpired          | UnsatisfiedConstraints
   | UnsupportedOperation
   | EOF
-#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
-  | ComError Int           -- HRESULT
-#endif
-  deriving (Eq)
+  | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
+
+instance Eq IOErrorType where
+   x == y = 
+     case x of
+       DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
+       _ -> getTag# x ==# getTag# y
 
 instance Show IOErrorType where
   showsPrec _ e =
@@ -534,11 +551,7 @@ instance Show IOErrorType where
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
       UnsupportedOperation -> "unsupported operation"
       EOF		-> "end of file"
-#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
-      ComError _	-> "COM error"
-#endif
-
-
+      DynIOError{}      -> "unknown IO error"
 
 userError       :: String  -> IOError
 userError str	=  UserError str