[project @ 2000-07-08 18:17:40 by panne]
[ghc-hetmet.git] / ghc / lib / std / PrelIOBase.lhs
index 2e43613..a50cc29 100644 (file)
@@ -1,7 +1,7 @@
-% -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.12 1999/08/23 12:53:25 keithw Exp $
+% ------------------------------------------------------------------------------
+% $Id: PrelIOBase.lhs,v 1.27 2000/07/08 18:17:40 panne Exp $
 % 
-% (c) The AQUA Project, Glasgow University, 1994-1998
+% (c) The University of Glasgow, 1994-2000
 %
 
 \section[PrelIOBase]{Module @PrelIOBase@}
@@ -11,7 +11,8 @@ concretely; the @IO@ module itself exports abstractly.
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-#include "cbits/error.h"
+#include "config.h"
+#include "cbits/stgerror.h"
 
 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
 module PrelIOBase where
@@ -20,12 +21,12 @@ 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 PrelAddr          ( Addr(..) )
 import PrelShow
+import PrelList
+import PrelDynamic
+import PrelPack ( unpackCString )
 
 #if !defined(__CONCURRENT_HASKELL__)
 import PrelArr   ( MutableVar, readVar )
@@ -33,14 +34,9 @@ import PrelArr         ( MutableVar, readVar )
 #endif
 
 #ifdef __HUGS__
-#define cat2(x,y)  x/**/y
-#define CCALL(fun) cat2(prim_,fun)
 #define __CONCURRENT_HASKELL__
 #define stToIO id
 #define unpackCString primUnpackString
-#else
-#define CCALL(fun) _ccall_ fun
-#define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
 #endif
 
 #ifndef __PARALLEL_HASKELL__
@@ -60,6 +56,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 #))
@@ -75,15 +88,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
 
@@ -93,6 +102,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}
 
@@ -133,6 +144,339 @@ unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
 
 %*********************************************************
 %*                                                     *
+\subsection{Types @Handle@, @Handle__@}
+%*                                                     *
+%*********************************************************
+
+The type for @Handle@ is defined rather than in @IOHandle@
+module, as the @IOError@ type uses it..all operations over
+a handles reside in @IOHandle@.
+
+\begin{code}
+
+#ifndef __HUGS__
+{-
+ Sigh, the MVar ops in ConcBase depend on IO, the IO
+ representation here depend on MVars for handles (when
+ compiling in a concurrent way). Break the cycle by having
+ the definition of MVars go here:
+
+-}
+data MVar a = MVar (MVar# RealWorld a)
+
+-- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
+instance Eq (MVar a) where
+       (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+
+{-
+  Double sigh - ForeignObj is needed here too to break a cycle.
+-}
+data ForeignObj = ForeignObj ForeignObj#   -- another one
+instance CCallable ForeignObj
+
+eqForeignObj :: ForeignObj  -> ForeignObj -> Bool
+eqForeignObj mp1 mp2
+  = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
+
+foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
+
+instance Eq ForeignObj where 
+    p == q = eqForeignObj p q
+    p /= q = not (eqForeignObj p q)
+#endif /* ndef __HUGS__ */
+
+#if defined(__CONCURRENT_HASKELL__)
+newtype Handle = Handle (MVar Handle__)
+#else
+newtype Handle = Handle (MutableVar RealWorld Handle__)
+#endif
+
+instance Eq Handle where
+ (Handle h1) == (Handle h2) = h1 == h2
+
+{-
+  A Handle is represented by (a reference to) a record 
+  containing the state of the I/O port/device. We record
+  the following pieces of info:
+
+    * type (read,write,closed etc.)
+    * pointer to the external file object.
+    * buffering mode 
+    * user-friendly name (usually the
+      FilePath used when IO.openFile was called)
+
+Note: when a Handle is garbage collected, we want to flush its buffer
+and close the OS file handle, so as to free up a (precious) resource.
+-}
+data Handle__
+  = Handle__ {
+      haFO__         :: FILE_OBJECT,
+      haType__        :: Handle__Type,
+      haBufferMode__  :: BufferMode,
+      haFilePath__    :: FilePath,
+      haBuffers__     :: [Addr]
+    }
+
+{-
+  Internally, we classify handles as being one
+  of the following:
+-}
+data Handle__Type
+ = ErrorHandle  IOException
+ | ClosedHandle
+ | SemiClosedHandle
+ | ReadHandle
+ | WriteHandle
+ | AppendHandle
+ | ReadWriteHandle
+
+
+-- File names are specified using @FilePath@, a OS-dependent
+-- string that (hopefully, I guess) maps to an accessible file/object.
+
+type FilePath = String
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection[Show-Handle]{Show instance for Handles}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+-- handle types are 'show'ed when printing error msgs, so
+-- we provide a more user-friendly Show instance for it
+-- than the derived one.
+instance Show Handle__Type where
+  showsPrec p t =
+    case t of
+      ErrorHandle iot   -> showString "error " . showsPrec p iot
+      ClosedHandle      -> showString "closed"
+      SemiClosedHandle  -> showString "semi-closed"
+      ReadHandle        -> showString "readable"
+      WriteHandle       -> showString "writeable"
+      AppendHandle      -> showString "writeable (append)"
+      ReadWriteHandle   -> showString "read-writeable"
+
+instance Show Handle where 
+  showsPrec p (Handle h) = 
+    let
+#if defined(__CONCURRENT_HASKELL__)
+#ifdef __HUGS__
+     hdl_ = unsafePerformIO (primTakeMVar h)
+#else
+     -- (Big) SIGH: unfolded defn of takeMVar to avoid
+     -- an (oh-so) unfortunate module loop with PrelConc.
+     hdl_ = unsafePerformIO (IO $ \ s# ->
+            case h               of { MVar h# ->
+            case takeMVar# h# s# of { (# s2# , r #) -> 
+                   (# s2#, r #) }})
+#endif
+#else
+     hdl_ = unsafePerformIO (stToIO (readVar h))
+#endif
+    in
+    showChar '{' . 
+    showHdl (haType__ hdl_) 
+           (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
+            showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
+            showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
+   where
+    showHdl :: Handle__Type -> ShowS -> ShowS
+    showHdl ht cont = 
+       case ht of
+        ClosedHandle  -> showsPrec p ht . showString "}\n"
+        ErrorHandle _ -> showsPrec p ht . showString "}\n"
+       _ -> cont
+       
+    showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
+    showBufMode fo bmo =
+      case bmo of
+        NoBuffering   -> showString "none"
+       LineBuffering -> showString "line"
+       BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
+       BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
+      where
+       def :: Int 
+       def = unsafePerformIO (getBufSize fo)
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection[BufferMode]{Buffering modes}
+%*                                                     *
+%*********************************************************
+
+Three kinds of buffering are supported: line-buffering, 
+block-buffering or no-buffering.  These modes have the following
+effects. For output, items are written out from the internal
+buffer according to the buffer mode:
+
+\begin{itemize}
+\item[line-buffering]  the entire output buffer is written
+out whenever a newline is output, the output buffer overflows, 
+a flush is issued, or the handle is closed.
+
+\item[block-buffering] the entire output buffer is written out whenever 
+it overflows, a flush is issued, or the handle
+is closed.
+
+\item[no-buffering] output is written immediately, and never stored
+in the output buffer.
+\end{itemize}
+
+The output buffer is emptied as soon as it has been written out.
+
+Similarly, input occurs according to the buffer mode for handle {\em hdl}.
+\begin{itemize}
+\item[line-buffering] when the input buffer for {\em hdl} is not empty,
+the next item is obtained from the buffer;
+otherwise, when the input buffer is empty,
+characters up to and including the next newline
+character are read into the buffer.  No characters
+are available until the newline character is
+available.
+\item[block-buffering] when the input buffer for {\em hdl} becomes empty,
+the next block of data is read into this buffer.
+\item[no-buffering] the next input item is read and returned.
+\end{itemize}
+
+For most implementations, physical files will normally be block-buffered 
+and terminals will normally be line-buffered. (the IO interface provides
+operations for changing the default buffering of a handle tho.)
+
+\begin{code}
+data BufferMode  
+ = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
+   deriving (Eq, Ord, Show)
+   {- Read instance defined in IO. -}
+
+\end{code}
+
+Foreign import declarations to helper routines:
+
+\begin{code}
+foreign import "libHS_cbits" "getErrStr__"  unsafe getErrStr__  :: IO Addr 
+foreign import "libHS_cbits" "getErrNo__"   unsafe getErrNo__   :: IO Int  
+foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int  
+
+foreign import "libHS_cbits" "allocMemory__" unsafe
+           allocMemory__    :: Int -> IO Addr
+foreign import "libHS_cbits" "getBufSize"  unsafe
+           getBufSize       :: FILE_OBJECT -> IO Int
+foreign import "libHS_cbits" "setBuf" unsafe
+           setBuf       :: FILE_OBJECT -> Addr -> Int -> IO ()
+
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection{Exception datatype and operations}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+data Exception
+  = IOException        IOException     -- IO exceptions
+  | ArithException     ArithException  -- Arithmetic exceptions
+  | ArrayException     ArrayException  -- Array-related exceptions
+  | ErrorCall          String          -- Calls to 'error'
+  | NoMethodError       String         -- A non-existent method was invoked
+  | PatternMatchFail   String          -- A pattern match / guard failure
+  | RecSelError                String          -- Selecting a non-existent field
+  | RecConError                String          -- Field missing in record construction
+  | RecUpdError                String          -- Record doesn't contain updated field
+  | AssertionFailed    String          -- Assertions
+  | DynException       Dynamic         -- Dynamic exceptions
+  | AsyncException     AsyncException  -- Externally generated errors
+  | PutFullMVar                        -- Put on a full MVar
+  | BlockedOnDeadMVar                  -- Blocking on a dead MVar
+  | NonTermination
+  | UserError          String
+
+data ArithException
+  = Overflow
+  | Underflow
+  | LossOfPrecision
+  | DivideByZero
+  | Denormal
+  deriving (Eq, Ord)
+
+data AsyncException
+  = StackOverflow
+  | HeapOverflow
+  | ThreadKilled
+  deriving (Eq, Ord)
+
+data ArrayException
+  = IndexOutOfBounds   String          -- out-of-range array access
+  | UndefinedElement   String          -- evaluating an undefined element
+  deriving (Eq, Ord)
+
+stackOverflow, heapOverflow :: Exception -- for the RTS
+stackOverflow = AsyncException StackOverflow
+heapOverflow  = AsyncException HeapOverflow
+
+instance Show ArithException where
+  showsPrec _ Overflow        = showString "arithmetic overflow"
+  showsPrec _ Underflow       = showString "arithmetic underflow"
+  showsPrec _ LossOfPrecision = showString "loss of precision"
+  showsPrec _ DivideByZero    = showString "divide by zero"
+  showsPrec _ Denormal        = showString "denormal"
+
+instance Show AsyncException where
+  showsPrec _ StackOverflow   = showString "stack overflow"
+  showsPrec _ HeapOverflow    = showString "heap overflow"
+  showsPrec _ ThreadKilled    = showString "thread killed"
+
+instance Show ArrayException where
+  showsPrec _ (IndexOutOfBounds s)
+       = showString "array index out of range"
+       . (if not (null s) then showString ": " . showString s
+                          else id)
+  showsPrec _ (UndefinedElement s)
+       = showString "undefined array element"
+       . (if not (null s) then showString ": " . showString s
+                          else id)
+
+instance Show Exception where
+  showsPrec _ (IOException err)                 = shows err
+  showsPrec _ (ArithException err)       = shows err
+  showsPrec _ (ArrayException err)       = shows err
+  showsPrec _ (ErrorCall err)           = showString err
+  showsPrec _ (NoMethodError err)        = showString err
+  showsPrec _ (PatternMatchFail err)     = showString err
+  showsPrec _ (RecSelError err)                 = showString err
+  showsPrec _ (RecConError err)                 = showString err
+  showsPrec _ (RecUpdError err)                 = showString err
+  showsPrec _ (AssertionFailed err)      = showString err
+  showsPrec _ (DynException _err)        = showString "unknown exception"
+  showsPrec _ (AsyncException e)        = shows e
+  showsPrec _ (PutFullMVar)             = showString "putMVar: full MVar"
+  showsPrec _ (BlockedOnDeadMVar)       = showString "thread blocked indefinitely"
+  showsPrec _ (NonTermination)           = showString "<<loop>>"
+  showsPrec _ (UserError err)            = showString err
+\end{code}
+
+%*********************************************************
+%*                                                     *
+\subsection{Primitive throw}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+throw :: Exception -> a
+throw exception = raise# exception
+
+ioError         :: Exception -> IO a 
+ioError err    =  IO $ \s -> throw err s
+
+ioException    :: IOException -> IO a
+ioException err =  IO $ \s -> throw (IOException err) s
+\end{code}
+
+%*********************************************************
+%*                                                     *
 \subsection{Type @IOError@}
 %*                                                     *
 %*********************************************************
@@ -143,14 +487,19 @@ string and maybe the handle that was used when the error was
 flagged.
 
 \begin{code}
-data IOError 
- = IOError 
+type IOError = Exception
+
+data IOException
+ = IOError
      (Maybe Handle)  -- the handle used by the action flagging the
                     -- the error.
      IOErrorType     -- what it was.
      String         -- location
      String          -- error type specific information.
 
+instance Eq IOException where
+  (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) = 
+    e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
 
 data IOErrorType
   = AlreadyExists        | HardwareFault
@@ -161,9 +510,9 @@ data IOErrorType
   | ResourceBusy         | ResourceExhausted
   | ResourceVanished     | SystemError
   | TimeExpired          | UnsatisfiedConstraints
-  | UnsupportedOperation | UserError
+  | UnsupportedOperation
   | EOF
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
   | ComError Int           -- HRESULT
 #endif
   deriving (Eq)
@@ -188,17 +537,16 @@ instance Show IOErrorType where
       SystemError      -> "system error"
       TimeExpired       -> "timeout"
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
-      UserError         -> "failed"
       UnsupportedOperation -> "unsupported operation"
       EOF              -> "end of file"
-#ifdef _WIN32
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
       ComError _       -> "COM error"
 #endif
 
 
 
 userError       :: String  -> IOError
-userError str  =  IOError Nothing UserError "" str
+userError str  =  UserError str
 \end{code}
 
 Predicates on IOError; little effort made on these so far...
@@ -206,36 +554,36 @@ Predicates on IOError; little effort made on these so far...
 \begin{code}
 
 isAlreadyExistsError :: IOError -> Bool
-isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
-isAlreadyExistsError _                            = False
+isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _)) = True
+isAlreadyExistsError _                                          = False
 
 isAlreadyInUseError :: IOError -> Bool
-isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
-isAlreadyInUseError _                           = False
+isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _)) = True
+isAlreadyInUseError _                                         = False
 
 isFullError :: IOError -> Bool
-isFullError (IOError _ ResourceExhausted _ _) = True
-isFullError _                                = False
+isFullError (IOException (IOError _ ResourceExhausted _ _)) = True
+isFullError _                                              = False
 
 isEOFError :: IOError -> Bool
-isEOFError (IOError _ EOF _ _) = True
-isEOFError _                   = False
+isEOFError (IOException (IOError _ EOF _ _)) = True
+isEOFError _                                        = False
 
 isIllegalOperation :: IOError -> Bool
-isIllegalOperation (IOError _ IllegalOperation _ _) = True
-isIllegalOperation _                               = False
+isIllegalOperation (IOException (IOError _ IllegalOperation _ _)) = True
+isIllegalOperation _                                             = False
 
 isPermissionError :: IOError -> Bool
-isPermissionError (IOError _ PermissionDenied _ _) = True
-isPermissionError _                               = False
+isPermissionError (IOException (IOError _ PermissionDenied _ _)) = True
+isPermissionError _                                             = False
 
 isDoesNotExistError :: IOError -> Bool
-isDoesNotExistError (IOError _ NoSuchThing _ _) = True
-isDoesNotExistError _                           = False
+isDoesNotExistError (IOException (IOError _ NoSuchThing _ _)) = True
+isDoesNotExistError _                                        = False
 
 isUserError :: IOError -> Bool
-isUserError (IOError _ UserError _ _) = True
-isUserError _                        = False
+isUserError (UserError _) = True
+isUserError _            = False
 \end{code}
 
 Showing @IOError@s
@@ -244,10 +592,10 @@ Showing @IOError@s
 #ifdef __HUGS__
 -- For now we give a fairly uninformative error message which just happens to
 -- be like the ones that Hugs used to give.
-instance Show IOError where
+instance Show IOException where
     showsPrec p (IOError hdl iot loc s) = showString s . showChar '\n'
 #else
-instance Show IOError where
+instance Show IOException where
     showsPrec p (IOError hdl iot loc s) =
       showsPrec p iot .
       showChar '\n' .
@@ -278,12 +626,12 @@ used.
 constructErrorAndFail :: String -> IO a
 constructErrorAndFail call_site
   = constructError call_site >>= \ io_error ->
-    ioError io_error
+    ioError (IOException io_error)
 
 constructErrorAndFailWithInfo :: String -> String -> IO a
 constructErrorAndFailWithInfo call_site reason
   = constructErrorMsg call_site (Just reason) >>= \ io_error ->
-    ioError io_error
+    ioError (IOException io_error)
 
 \end{code}
 
@@ -301,13 +649,13 @@ information. Error constructing functions will then reach out
 and grab these values when generating
 
 \begin{code}
-constructError       :: String -> IO IOError
+constructError       :: String -> IO IOException
 constructError call_site = constructErrorMsg call_site Nothing
 
-constructErrorMsg            :: String -> Maybe String -> IO IOError
+constructErrorMsg            :: String -> Maybe String -> IO IOException
 constructErrorMsg call_site reason =
- CCALL(getErrType__)            >>= \ errtype ->
- CCALL(getErrStr__)             >>= \ str ->
+ getErrType__            >>= \ errtype ->
+ getErrStr__             >>= \ str ->
  let
   iot =
    case (errtype::Int) of
@@ -342,204 +690,3 @@ constructErrorMsg call_site reason =
  in
  return (IOError Nothing iot call_site msg)
 \end{code}
-
-File names are specified using @FilePath@, a OS-dependent
-string that (hopefully, I guess) maps to an accessible file/object.
-
-\begin{code}
-type FilePath = String
-\end{code}
-
-%*********************************************************
-%*                                                     *
-\subsection{Types @Handle@, @Handle__@}
-%*                                                     *
-%*********************************************************
-
-The type for @Handle@ is defined rather than in @IOHandle@
-module, as the @IOError@ type uses it..all operations over
-a handles reside in @IOHandle@.
-
-\begin{code}
-
-#ifndef __HUGS__
-{-
- Sigh, the MVar ops in ConcBase depend on IO, the IO
- representation here depend on MVars for handles (when
- compiling in a concurrent way). Break the cycle by having
- the definition of MVars go here:
-
--}
-data MVar a = MVar (MVar# RealWorld a)
-
-{-
-  Double sigh - ForeignObj is needed here too to break a cycle.
--}
-data ForeignObj = ForeignObj ForeignObj#   -- another one
-instance CCallable ForeignObj
-instance CCallable ForeignObj#
-#endif /* ndef __HUGS__ */
-
-#if defined(__CONCURRENT_HASKELL__)
-newtype Handle = Handle (MVar Handle__)
-#else
-newtype Handle = Handle (MutableVar RealWorld Handle__)
-#endif
-
-{-
-  A Handle is represented by (a reference to) a record 
-  containing the state of the I/O port/device. We record
-  the following pieces of info:
-
-    * type (read,write,closed etc.)
-    * pointer to the external file object.
-    * buffering mode 
-    * user-friendly name (usually the
-      FilePath used when IO.openFile was called)
-
-Note: when a Handle is garbage collected, we want to flush its buffer
-and close the OS file handle, so as to free up a (precious) resource.
--}
-data Handle__
-  = Handle__ {
-      haFO__         :: FILE_OBJECT,
-      haType__        :: Handle__Type,
-      haBufferMode__  :: BufferMode,
-      haFilePath__    :: FilePath
-    }      
-
-{-
-  Internally, we classify handles as being one
-  of the following:
--}
-data Handle__Type
- = ErrorHandle  IOError
- | ClosedHandle
- | SemiClosedHandle
- | ReadHandle
- | WriteHandle
- | AppendHandle
- | ReadWriteHandle
-
-
--- handle types are 'show'ed when printing error msgs, so
--- we provide a more user-friendly Show instance for it
--- than the derived one.
-instance Show Handle__Type where
-  showsPrec p t =
-    case t of
-      ErrorHandle iot   -> showString "error " . showsPrec p iot
-      ClosedHandle      -> showString "closed"
-      SemiClosedHandle  -> showString "semi-closed"
-      ReadHandle        -> showString "readable"
-      WriteHandle       -> showString "writeable"
-      AppendHandle      -> showString "writeable (append)"
-      ReadWriteHandle   -> showString "read-writeable"
-
-instance Show Handle where 
-  showsPrec p (Handle h) = 
-    let
-#if defined(__CONCURRENT_HASKELL__)
-#ifdef __HUGS__
-     hdl_ = unsafePerformIO (primTakeMVar h)
-#else
-     -- (Big) SIGH: unfolded defn of takeMVar to avoid
-     -- an (oh-so) unfortunate module loop with PrelConc.
-     hdl_ = unsafePerformIO (IO $ \ s# ->
-            case h               of { MVar h# ->
-            case takeMVar# h# s# of { (# s2# , r #) -> 
-                   (# s2#, r #) }})
-#endif
-#else
-     hdl_ = unsafePerformIO (stToIO (readVar h))
-#endif
-    in
-    showChar '{' . 
-    showHdl (haType__ hdl_) 
-           (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
-            showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
-            showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
-   where
-    showHdl :: Handle__Type -> ShowS -> ShowS
-    showHdl ht cont = 
-       case ht of
-        ClosedHandle  -> showsPrec p ht . showString "}\n"
-        ErrorHandle _ -> showsPrec p ht . showString "}\n"
-       _ -> cont
-       
-    showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
-    showBufMode fo bmo =
-      case bmo of
-        NoBuffering   -> showString "none"
-       LineBuffering -> showString "line"
-       BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
-       BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
-      where
-       def :: Int 
-       def = unsafePerformIO (CCALL(getBufSize) fo)
-
-mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
-mkBuffer__ fo sz_in_bytes = do
- chunk <- 
-  case sz_in_bytes of
-    0 -> return nullAddr  -- this has the effect of overwriting the pointer to the old buffer.
-    _ -> do
-     chunk <- CCALL(allocMemory__) sz_in_bytes
-     if chunk == nullAddr
-      then ioError (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
-      else return chunk
- CCALL(setBuf) fo chunk sz_in_bytes
-
-\end{code}
-
-%*********************************************************
-%*                                                     *
-\subsection[BufferMode]{Buffering modes}
-%*                                                     *
-%*********************************************************
-
-Three kinds of buffering are supported: line-buffering, 
-block-buffering or no-buffering.  These modes have the following
-effects. For output, items are written out from the internal
-buffer according to the buffer mode:
-
-\begin{itemize}
-\item[line-buffering]  the entire output buffer is written
-out whenever a newline is output, the output buffer overflows, 
-a flush is issued, or the handle is closed.
-
-\item[block-buffering] the entire output buffer is written out whenever 
-it overflows, a flush is issued, or the handle
-is closed.
-
-\item[no-buffering] output is written immediately, and never stored
-in the output buffer.
-\end{itemize}
-
-The output buffer is emptied as soon as it has been written out.
-
-Similarly, input occurs according to the buffer mode for handle {\em hdl}.
-\begin{itemize}
-\item[line-buffering] when the input buffer for {\em hdl} is not empty,
-the next item is obtained from the buffer;
-otherwise, when the input buffer is empty,
-characters up to and including the next newline
-character are read into the buffer.  No characters
-are available until the newline character is
-available.
-\item[block-buffering] when the input buffer for {\em hdl} becomes empty,
-the next block of data is read into this buffer.
-\item[no-buffering] the next input item is read and returned.
-\end{itemize}
-
-For most implementations, physical files will normally be block-buffered 
-and terminals will normally be line-buffered. (the IO interface provides
-operations for changing the default buffering of a handle tho.)
-
-\begin{code}
-data BufferMode  
- = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
-   deriving (Eq, Ord, Show)
-   {- Read instance defined in IO. -}
-
-\end{code}