[project @ 1997-03-14 05:27:40 by sof]

OGI changes through 130397

11 files changed, 577 insertions, 380 deletions

diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs
index c46aef51d3..0440cf022b 100644
--- a/ghc/lib/ghc/ArrBase.lhs
+++ b/ghc/lib/ghc/ArrBase.lhs
@@ -1,13 +1,15 @@
 %
 % (c) The AQUA Project, Glasgow University, 1994-1996
 %
-
 \section[ArrBase]{Module @ArrBase@}
 
+Array implementation, @ArrBase@ exports the basic array
+types and operations.
+
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module  ArrBase where
+module ArrBase where
 
 import {-# SOURCE #-}	IOBase	( error )
 import Ix
@@ -52,6 +54,9 @@ data Ix ix => Array ix elt		= Array     	   (ix,ix) (Array# elt)
 data Ix ix => ByteArray ix      	= ByteArray	   (ix,ix) ByteArray#
 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
+
+-- A one-element mutable array:
+type MutableVar s a = MutableArray s Int a
 \end{code}
 
 
@@ -93,10 +98,10 @@ arrEleBottom = error "(Array.!): undefined array element"
 
 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
 fill_it_in arr lst
-  = foldr fill_one_in (returnStrictlyST ()) lst
+  = foldr fill_one_in (returnST ()) lst
   where  -- **** STRICT **** (but that's OK...)
     fill_one_in (i, v) rst
-      = writeArray arr i v `seqStrictlyST` rst
+      = writeArray arr i v `seqST` rst
 
 -----------------------------------------------------------------------
 -- these also go better with magic: (//), accum, accumArray
@@ -104,9 +109,9 @@ fill_it_in arr lst
 old_array // ivs
   = runST (
 	-- copy the old array:
-	thawArray old_array		    `thenStrictlyST` \ arr ->	
+	thawArray old_array		    `thenST` \ arr ->	
 	-- now write the new elements into the new array:
-	fill_it_in arr ivs		    `seqStrictlyST`
+	fill_it_in arr ivs		    `seqST`
 	freezeArray arr
     )
   where
@@ -116,17 +121,17 @@ zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt
 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 
 zap_with_f f arr lst
-  = foldr zap_one (returnStrictlyST ()) lst
+  = foldr zap_one (returnST ()) lst
   where
     zap_one (i, new_v) rst
-      = readArray  arr i		 `thenStrictlyST`  \ old_v ->
-	writeArray arr i (f old_v new_v) `seqStrictlyST`
+      = readArray  arr i		 `thenST`  \ old_v ->
+	writeArray arr i (f old_v new_v) `seqST`
 	rst
 
 accum f old_array ivs
   = runST (
 	-- copy the old array:
-	thawArray old_array		    `thenStrictlyST` \ arr ->	
+	thawArray old_array		    `thenST` \ arr ->	
 
 	-- now zap the elements in question with "f":
 	zap_with_f f arr ivs		>>
@@ -448,7 +453,7 @@ freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableArray# s# to#
-	  | True
+	  | otherwise
 	    = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
 	      case writeArray# to#   cur# ele s1# of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -481,7 +486,7 @@ freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableByteArray# s# to#
-	  | True
+	  | otherwise
 	    = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
 	      case (writeCharArray# to#   cur# ele s1#) of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -514,7 +519,7 @@ freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) -
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableByteArray# s# to#
-	  | True
+	  | otherwise
 	    = case (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
 	      case (writeIntArray# to#   cur# ele s1#) of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -547,7 +552,7 @@ freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableByteArray# s# to#
-	  | True
+	  | otherwise
 	    = case (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
 	      case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -580,7 +585,7 @@ freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableByteArray# s# to#
-	  | True
+	  | otherwise
 	    = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
 	      case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -613,7 +618,7 @@ freezeDoubleArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableByteArray# s# to#
-	  | True
+	  | otherwise
 	    = case (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
 	      case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
 	      copy (cur# +# 1#) end# from# to# s2#
@@ -670,7 +675,7 @@ thawArray (Array ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 	copy cur# end# from# to# s#
 	  | cur# ==# end#
 	    = StateAndMutableArray# s# to#
-	  | True
+	  | otherwise
 	    = case indexArray#  from# cur#       of { Lift ele ->
 	      case writeArray# to#   cur# ele s# of { s1# ->
 	      copy (cur# +# 1#) end# from# to# s1#
diff --git a/ghc/lib/ghc/ConcBase.lhs b/ghc/lib/ghc/ConcBase.lhs
index 3a5327163c..8dd40971a8 100644
--- a/ghc/lib/ghc/ConcBase.lhs
+++ b/ghc/lib/ghc/ConcBase.lhs
@@ -7,6 +7,7 @@
 Basic concurrency stuff
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
 module ConcBase(
 		-- Forking and suchlike
 	ST,	forkST,
@@ -19,14 +20,14 @@ module ConcBase(
 	MVar, newMVar, newEmptyMVar, takeMVar, putMVar, readMVar, swapMVar
     ) where
 
-import Prelude
+import PrelBase
 import STBase	( PrimIO(..), ST(..), State(..), StateAndPtr#(..) )
-import IOBase	( IO(..) )
+import IOBase	( IO(..), MVar(..) )
 import GHCerr	( parError )
 import PrelBase	( Int(..) )
 import GHC	( fork#, delay#, waitRead#, waitWrite#,
 		  SynchVar#, newSynchVar#, takeMVar#, putMVar#,
-		  State#, RealWorld
+		  State#, RealWorld, par#
 		)
 
 infixr 0 `par`, `fork`
@@ -90,7 +91,7 @@ are allowed, but there must be at least one read between any two
 writes.
 
 \begin{code}
-data MVar a = MVar (SynchVar# RealWorld a)
+--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 
 newEmptyMVar  :: IO (MVar a)
 
diff --git a/ghc/lib/ghc/GHC.hi-boot b/ghc/lib/ghc/GHC.hi-boot
index 040802b5c6..884bba09ac 100644
--- a/ghc/lib/ghc/GHC.hi-boot
+++ b/ghc/lib/ghc/GHC.hi-boot
@@ -11,7 +11,7 @@ GHC
   ->
 
   Void
-  void
+-- void CAF is defined in PrelBase
 
 -- I/O primitives
   RealWorld
@@ -20,7 +20,13 @@ GHC
 
   fork#
   delay# 
-  
+  seq#
+  par#
+  parGlobal#
+  parLocal#
+  parAt#
+  parAtForNow#
+
   SynchVar#
   newSynchVar#
   takeMVar#
@@ -162,6 +168,7 @@ GHC
   MutableByteArray#
   
   sameMutableArray#
+  sameMutableByteArray#
   
   newArray#
   newCharArray#
@@ -177,12 +184,12 @@ GHC
   indexDoubleArray#
   indexAddrArray#
   
-  indexOffAddr#
-  indexCharOffAddr#
-  indexIntOffAddr#
-  indexFloatOffAddr#
-  indexDoubleOffAddr#
-  indexAddrOffAddr#
+--  indexOffAddr#
+indexCharOffAddr#
+indexIntOffAddr#
+indexFloatOffAddr#
+indexDoubleOffAddr#
+indexAddrOffAddr#
   
   writeArray#
   writeCharArray#
diff --git a/ghc/lib/ghc/GHCerr.lhs b/ghc/lib/ghc/GHCerr.lhs
index c0d508d6c0..884146111a 100644
--- a/ghc/lib/ghc/GHCerr.lhs
+++ b/ghc/lib/ghc/GHCerr.lhs
@@ -12,9 +12,12 @@ We cannot define these functions in a module where they might be used
 with what the typechecker figures out.
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
 module GHCerr where
 
-import Prelude
+--import Prelude
+import PrelBase
+import PrelList ( span )
 import IOBase
 
 ---------------------------------------------------------------
@@ -27,13 +30,20 @@ augment = error "GHCbase.augment"
 --{-# GENERATE_SPECS build a #-}
 --build 		:: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
 --build g 	= g (:) []
+\end{code}
 
 
----------------------------------------------------------------
--- Used for compiler-generated error message;
--- encoding saves bytes of string junk.
+Used for compiler-generated error message;
+encoding saves bytes of string junk.
 
+\begin{code}
 absentErr, parError :: a
+
+absentErr = error "Oops! The program has entered an `absent' argument!\n"
+parError  = error "Oops! Entered GHCerr.parError (a GHC bug -- please report it!)\n"
+\end{code}
+
+\begin{code}
 irrefutPatError
  , noDefaultMethodError
  , noExplicitMethodError
@@ -42,31 +52,43 @@ irrefutPatError
  , recConError
  , recUpdError :: String -> a
 
-absentErr = error "Oops! The program has entered an `absent' argument!\n"
-parError  = error "Oops! Entered GHCerr.parError (a GHC bug -- please report it!)\n"
-
 noDefaultMethodError     s = error ("noDefaultMethodError:"++s)
 noExplicitMethodError    s = error ("No default method for class operation "++s)
+irrefutPatError		 s = error (untangle s "Irrefutable pattern failed for pattern")
+nonExhaustiveGuardsError s = error (untangle s "Non-exhaustive guards in")
+patError 		 s = error (untangle s "Non-exhaustive patterns in")
+recConError 		 s = error (untangle s "Missing field in record construction:")
+recUpdError 		 s = error (untangle s "Record to doesn't contain field(s) to be updated")
+\end{code}
+
 
-irrefutPatError s	    = patError__ (untangle s "irrefutable pattern")
-nonExhaustiveGuardsError s  = patError__ (untangle s "non-exhaustive guards")
-patError s		    = patError__ (untangle s "pattern-matching")
+(untangle coded message) expects "coded" to be of the form 
 
-patError__ = error__ (\ x -> _ccall_ PatErrorHdrHook x)
+	"location|details"
 
-recConError s = error (untangle s "record constructor")
-recUpdError s = error (untangle s "record update")
+It prints
 
-untangle coded in_str
-  =  "In "     ++ in_str
-  ++ (if null msg then "" else (": " ++ msg))
-  ++ "; at "   ++ file
-  ++ ", line " ++ line
+	location message details
+
+\begin{code}
+untangle coded message
+  =  location
+  ++ ": " 
+  ++ message
+  ++ details
   ++ "\n"
   where
-    (file,line,msg)
-      = case (span not_bar coded) of { (f, (_:rest)) ->
-	case (span not_bar rest)  of { (l, (_:m)) ->
-	(f,l,m) }}
+    (location, details)
+      = case (span not_bar coded) of { (location, rest) ->
+	case rest of
+	  ('|':details) -> (location, ' ' : details)
+	  _	        -> (location, "")
+	}
     not_bar c = c /= '|'
 \end{code}
+
+-- This local variant of "error" calls PatErrorHdrHook instead of ErrorHdrHook,
+-- but the former does exactly the same as the latter, so I nuked it.
+--		SLPJ Jan 97
+-- patError__ = error__ (\ x -> _ccall_ PatErrorHdrHook x)
+
diff --git a/ghc/lib/ghc/IOBase.lhs b/ghc/lib/ghc/IOBase.lhs
index 8214bd3c7a..4a952f718f 100644
--- a/ghc/lib/ghc/IOBase.lhs
+++ b/ghc/lib/ghc/IOBase.lhs
@@ -19,7 +19,9 @@ import PrelTup
 import Foreign
 import PackedString	( unpackCString )
 import PrelBase
+import PrelRead
 import GHC
+import ArrBase	( ByteArray(..), MutableVar(..) )
 
 infixr 1 `thenIO_Prim`
 \end{code}
@@ -37,12 +39,9 @@ instance  Functor IO where
    map f x = x >>= (return . f)
 
 instance  Monad IO  where
-{-	No inlining for now... until we can inline some of the
-	imports, like $, these functions are pretty big. 
     {-# INLINE return #-}
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
--}
     m >> k      =  m >>= \ _ -> k
     return x	= IO $ ST $ \ s@(S# _) -> (Right x, s)
 
@@ -69,7 +68,7 @@ fail            :: IOError -> IO a
 fail err	=  IO $ ST $ \ s -> (Left err, s)
 
 userError       :: String  -> IOError
-userError str	=  UserError str
+userError str	=  IOError Nothing UserError str
 
 catch           :: IO a    -> (IOError -> IO a) -> IO a 
 catch (IO (ST m)) k  = IO $ ST $ \ s ->
@@ -222,107 +221,84 @@ fputs stream (c : cs)
 %*							*
 %*********************************************************
 
+A value @IOError@ encode errors occurred in the @IO@ monad.
+An @IOError@ records a more specific error type, a descriptive
+string and maybe the handle that was used when the error was
+flagged.
+
 \begin{code}
-data IOError
-  = AlreadyExists		String
-  | HardwareFault		String
-  | IllegalOperation		String
-  | InappropriateType		String
-  | Interrupted			String
-  | InvalidArgument		String
-  | NoSuchThing			String
-  | OtherError			String
-  | PermissionDenied		String
-  | ProtocolError		String
-  | ResourceBusy		String
-  | ResourceExhausted		String
-  | ResourceVanished		String
-  | SystemError			String
-  | TimeExpired			String
-  | UnsatisfiedConstraints	String
-  | UnsupportedOperation	String
-  | UserError			String
-  | EOF
+data IOError 
+ = IOError 
+     (Maybe Handle)  -- the handle used by the action flagging the
+		     -- the error.
+     IOErrorType     -- what it was.
+     String          -- error type specific information.
 
 instance Eq IOError where
-    -- I don't know what the (pointless) idea is here,
-    -- presumably just compare them by their tags (WDP)
-    a == b = tag a == tag b
-      where
-	tag (AlreadyExists _)		= (1::Int)
-	tag (HardwareFault _)		= 2
-	tag (IllegalOperation _)	= 3
-	tag (InappropriateType _)	= 4
-	tag (Interrupted _)		= 5
-	tag (InvalidArgument _)		= 6
-	tag (NoSuchThing _)		= 7
-	tag (OtherError _)		= 8
-	tag (PermissionDenied _)	= 9
-	tag (ProtocolError _)		= 10
-	tag (ResourceBusy _)		= 11
-	tag (ResourceExhausted _)	= 12
-	tag (ResourceVanished _)	= 13
-	tag (SystemError _)		= 14
-	tag (TimeExpired _)		= 15
-	tag (UnsatisfiedConstraints _)	= 16
-	tag (UnsupportedOperation _)	= 17
-	tag (UserError _)		= 18
-	tag EOF				= 19
+  (IOError h1 e1 str1) == (IOError h2 e2 str2) = 
+    e1==e2 && str1==str2 && h1==h2
+
+data IOErrorType
+  = AlreadyExists        | HardwareFault
+  | IllegalOperation     | InappropriateType
+  | Interrupted          | InvalidArgument
+  | NoSuchThing          | OtherError
+  | PermissionDenied     | ProtocolError
+  | ResourceBusy         | ResourceExhausted
+  | ResourceVanished     | SystemError
+  | TimeExpired          | UnsatisfiedConstraints
+  | UnsupportedOperation | UserError
+  | EOF
+  deriving (Eq, Show)
+
 \end{code}
 
-Predicates on IOError; almost no effort made on these so far...
+Predicates on IOError; little effort made on these so far...
 
 \begin{code}
 
-isAlreadyExistsError (AlreadyExists _) = True
-isAlreadyExistsError _		       = False
+isAlreadyExistsError (IOError _ AlreadyExists _) = True
+isAlreadyExistsError _		                 = False
+
+isAlreadyInUseError (IOError _ ResourceBusy _) = True
+isAlreadyInUseError _		               = False
 
-isAlreadyInUseError (ResourceBusy _) = True
-isAlreadyInUseError _		     = False
+isFullError (IOError _ ResourceExhausted _) = True
+isFullError _			            = False
 
-isFullError (ResourceExhausted _) = True
-isFullError _			  = False
+isEOFError (IOError _ EOF _) = True
+isEOFError _                 = True
 
-isEOFError EOF = True
-isEOFError _   = True
+isIllegalOperation (IOError _ IllegalOperation _) = True
+isIllegalOperation _			          = False
 
-isIllegalOperation (IllegalOperation _) = True
-isIllegalOperation _			= False
+isPermissionError (IOError _ PermissionDenied _) = True
+isPermissionError _			         = False
 
-isPermissionError (PermissionDenied _)	= True
-isPermissionError _			= False
+isDoesNotExistError (IOError _ NoSuchThing _) = True
+isDoesNotExistError _                         = False
 
-isUserError (UserError s) = Just s
-isUserError _		  = Nothing
+isUserError (IOError _ UserError s) = Just s
+isUserError _		            = Nothing
 \end{code}
 
 Showing @IOError@s
 
 \begin{code}
 instance Show IOError where
-    showsPrec p (AlreadyExists s)	= show2 "AlreadyExists: "	s
-    showsPrec p (HardwareFault s)	= show2 "HardwareFault: "	s
-    showsPrec p (IllegalOperation s)	= show2 "IllegalOperation: "	s
-    showsPrec p (InappropriateType s)	= show2 "InappropriateType: "	s
-    showsPrec p (Interrupted s)		= show2 "Interrupted: "		s
-    showsPrec p (InvalidArgument s)	= show2 "InvalidArgument: "	s
-    showsPrec p (NoSuchThing s)		= show2 "NoSuchThing: "		s
-    showsPrec p (OtherError s)		= show2 "OtherError: "		s
-    showsPrec p (PermissionDenied s)	= show2 "PermissionDenied: "	s
-    showsPrec p (ProtocolError s)	= show2 "ProtocolError: "	s
-    showsPrec p (ResourceBusy s)	= show2 "ResourceBusy: "	s
-    showsPrec p (ResourceExhausted s)	= show2 "ResourceExhausted: "	s
-    showsPrec p (ResourceVanished s)	= show2 "ResourceVanished: "	s
-    showsPrec p (SystemError s)		= show2 "SystemError: "		s
-    showsPrec p (TimeExpired s)		= show2 "TimeExpired: "		s
-    showsPrec p (UnsatisfiedConstraints s) = show2 "UnsatisfiedConstraints: " s
-    showsPrec p (UnsupportedOperation s)= show2 "UnsupportedOperation: " s
-    showsPrec p (UserError s)		= showString s
-    showsPrec p EOF			= showString "EOF"
-
-show2 x y = showString x . showString y
+    showsPrec p (IOError _ UserError s) rs =
+      showString s rs
+    showsPrec p (IOError _ EOF _) rs =
+      showsPrec p EOF rs
+    showsPrec p (IOError _ iot s) rs =
+      showsPrec p 
+                iot 
+                (case s of { 
+		  "" -> rs; 
+		  _ -> showString ": " $ 
+		       showString s rs})
 
-{-
+\end{code}
 
 The @String@ part of an @IOError@ is platform-dependent.  However, to
 provide a uniform mechanism for distinguishing among errors within
@@ -331,42 +307,155 @@ the exact strings to be used for particular errors.  For errors not
 explicitly mentioned in the standard, any descriptive string may be
 used.
 
-  SOF 4/96 - added argument to indicate function that flagged error
--}
-constructErrorAndFail :: String -> IO a
-constructError	      :: String -> PrimIO IOError
+\begin{change}
+SOF & 4/96 & added argument to indicate function that flagged error
+\end{change}
+% Hmm..does these envs work?!...SOF
 
+\begin{code}
+constructErrorAndFail :: String -> IO a
 constructErrorAndFail call_site
   = stToIO (constructError call_site) >>= \ io_error ->
     fail io_error
 
-constructError call_site
-  = _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
-    _casm_ ``%r = ghc_errstr;''	    >>= \ str ->
-    let
-	msg = call_site ++ ':' : ' ' : unpackCString str
-    in
-    return (case errtype# of
-	ERR_ALREADYEXISTS#		-> AlreadyExists msg
-	ERR_HARDWAREFAULT#		-> HardwareFault msg
-	ERR_ILLEGALOPERATION#		-> IllegalOperation msg
-	ERR_INAPPROPRIATETYPE#		-> InappropriateType msg
-	ERR_INTERRUPTED#		-> Interrupted msg
-	ERR_INVALIDARGUMENT#		-> InvalidArgument msg
-	ERR_NOSUCHTHING#		-> NoSuchThing msg
-	ERR_OTHERERROR#			-> OtherError msg
-	ERR_PERMISSIONDENIED#		-> PermissionDenied msg
-	ERR_PROTOCOLERROR#		-> ProtocolError msg
-	ERR_RESOURCEBUSY#		-> ResourceBusy msg
-	ERR_RESOURCEEXHAUSTED#		-> ResourceExhausted msg
-	ERR_RESOURCEVANISHED#		-> ResourceVanished msg
-	ERR_SYSTEMERROR#		-> SystemError msg
-	ERR_TIMEEXPIRED#		-> TimeExpired msg
-	ERR_UNSATISFIEDCONSTRAINTS#	-> UnsatisfiedConstraints msg
-	ERR_UNSUPPORTEDOPERATION#	-> UnsupportedOperation msg
-	ERR_EOF#			-> EOF
-	_				-> OtherError "bad error construct"
-    )
 \end{code}
 
+This doesn't seem to be documented/spelled out anywhere,
+so here goes: (SOF)
+
+The implementation of the IO prelude uses various C stubs
+to do the actual interaction with the OS. The bandwidth
+\tr{C<->Haskell} is somewhat limited, so the general strategy
+for flaggging any errors (apart from possibly using the
+return code of the external call), is to set the @ghc_errtype@
+to a value that is one of the \tr{#define}s in @includes/error.h@.
+@ghc_errstr@ holds a character string providing error-specific
+information.
+
+\begin{code}
+constructError	      :: String -> PrimIO IOError
+constructError call_site =
+ _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
+ _casm_ ``%r = ghc_errstr;''	    >>= \ str ->
+ let
+  iot =
+   case errtype# of
+     ERR_ALREADYEXISTS#	         -> AlreadyExists
+     ERR_HARDWAREFAULT#	         -> HardwareFault
+     ERR_ILLEGALOPERATION#	 -> IllegalOperation
+     ERR_INAPPROPRIATETYPE#	 -> InappropriateType
+     ERR_INTERRUPTED#	         -> Interrupted
+     ERR_INVALIDARGUMENT#	 -> InvalidArgument
+     ERR_NOSUCHTHING#	         -> NoSuchThing
+     ERR_OTHERERROR#		 -> OtherError
+     ERR_PERMISSIONDENIED#	 -> PermissionDenied
+     ERR_PROTOCOLERROR#	         -> ProtocolError
+     ERR_RESOURCEBUSY#	         -> ResourceBusy
+     ERR_RESOURCEEXHAUSTED#	 -> ResourceExhausted
+     ERR_RESOURCEVANISHED#	 -> ResourceVanished
+     ERR_SYSTEMERROR#	         -> SystemError
+     ERR_TIMEEXPIRED#	         -> TimeExpired
+     ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
+     ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
+     ERR_EOF#		         -> EOF
+     _			         -> OtherError
+
+  msg = 
+   case iot of
+     EOF -> ""
+     OtherError -> "bad error construct"
+     _   -> call_site ++ ':' : ' ' : unpackCString str
+ in
+ return (IOError Nothing iot msg)
+\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}
+
+{-
+ Sigh, the MVar ops in ConcBase depend on IO, the IO
+ representation here depend on MVars for handles (when
+ compiling a concurrent way). Break the cycle by having
+ the definition of MVars go here:
+
+-}
+data MVar a = MVar (SynchVar# RealWorld a)
+
+#if defined(__CONCURRENT_HASKELL__)
+type Handle = MVar Handle__
+#else
+type Handle = MutableVar RealWorld Handle__
+#endif
+
+data Handle__
+  = ErrorHandle		IOError
+  | ClosedHandle
+  | SemiClosedHandle	ForeignObj (Addr, Int)
+  | ReadHandle		ForeignObj (Maybe BufferMode) Bool
+  | WriteHandle		ForeignObj (Maybe BufferMode) Bool
+  | AppendHandle	ForeignObj (Maybe BufferMode) Bool
+  | ReadWriteHandle	ForeignObj (Maybe BufferMode) Bool
+
+-- Standard Instances as defined by the Report..
+
+instance Eq Handle {-partain:????-}
+instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
+
+\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.
+
+\begin{code}
+data BufferMode  
+ = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
+   deriving (Eq, Ord, Read, Show)
+\end{code}
diff --git a/ghc/lib/ghc/IOHandle.lhs b/ghc/lib/ghc/IOHandle.lhs
index 3e88c46b8c..50e1300c98 100644
--- a/ghc/lib/ghc/IOHandle.lhs
+++ b/ghc/lib/ghc/IOHandle.lhs
@@ -10,7 +10,7 @@ which are supported for them.
 \begin{code}
 #include "error.h"
 
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 
 module IOHandle where
 
@@ -23,7 +23,11 @@ import IOBase
 import PrelTup
 import PrelBase
 import GHC
-
+import Foreign  ( makeForeignObj )
+import PrelList (span)
+#if defined(__CONCURRENT_HASKELL__)
+import ConcBase
+#endif
 \end{code}
 
 
@@ -33,43 +37,28 @@ import GHC
 %*							*
 %*********************************************************
 
+The @Handle@ and @Handle__@ types are defined in @IOBase@.
+
 \begin{code}
 type FilePath = String
 
-#if defined(__CONCURRENT_HASKELL__)
-type Handle = MVar Handle__
+{-# INLINE newHandle   #-}
+{-# INLINE readHandle  #-}
+{-# INLINE writeHandle #-}
+newHandle   :: Handle__ -> IO Handle
+readHandle  :: Handle   -> IO Handle__
+writeHandle :: Handle -> Handle__ -> IO ()
 
+#if defined(__CONCURRENT_HASKELL__)
 newHandle   = newMVar
 readHandle  = takeMVar
 writeHandle = putMVar
-
-#else
-type Handle = MutableVar RealWorld Handle__
-
+#else 
 newHandle v     = stToIO (newVar   v)
 readHandle h    = stToIO (readVar  h)
 writeHandle h v = stToIO (writeVar h v)
+#endif
 
-#endif {- __CONCURRENT_HASKELL__ -}
-
-data Handle__
-  = ErrorHandle		IOError
-  | ClosedHandle
-  | SemiClosedHandle	Addr (Addr, Int)
-  | ReadHandle		Addr (Maybe BufferMode) Bool
-  | WriteHandle		Addr (Maybe BufferMode) Bool
-  | AppendHandle	Addr (Maybe BufferMode) Bool
-  | ReadWriteHandle	Addr (Maybe BufferMode) Bool
-
-instance Eq Handle{-partain:????-}
-
-{-# INLINE newHandle   #-}
-{-# INLINE readHandle  #-}
-{-# INLINE writeHandle #-}
-
-newHandle   :: Handle__ -> IO Handle
-readHandle  :: Handle   -> IO Handle__
-writeHandle :: Handle -> Handle__ -> IO ()
 \end{code}
 
 %*********************************************************
@@ -79,7 +68,7 @@ writeHandle :: Handle -> Handle__ -> IO ()
 %*********************************************************
 
 \begin{code}
-filePtr :: Handle__ -> Addr
+filePtr :: Handle__ -> ForeignObj
 filePtr (SemiClosedHandle fp _)  = fp
 filePtr (ReadHandle fp _ _)	 = fp
 filePtr (WriteHandle fp _ _)	 = fp
@@ -127,7 +116,8 @@ stdin = unsafePerformPrimIO (
     _ccall_ getLock (``stdin''::Addr) 0		>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> new_handle (ReadHandle ``stdin'' Nothing False)
+       1 -> makeForeignObj (``stdin''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+	    new_handle (ReadHandle fp Nothing False)
        _ -> constructError "stdin"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -140,7 +130,8 @@ stdout = unsafePerformPrimIO (
     _ccall_ getLock (``stdout''::Addr) 1	>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> new_handle (WriteHandle ``stdout'' Nothing False)
+       1 -> makeForeignObj (``stdout''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+	    new_handle (WriteHandle fp Nothing False)
        _ -> constructError "stdout"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -153,7 +144,8 @@ stderr = unsafePerformPrimIO (
     _ccall_ getLock (``stderr''::Addr) 1	>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> new_handle (WriteHandle ``stderr'' (Just NoBuffering) False)	
+       1 -> makeForeignObj (``stderr''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+            new_handle (WriteHandle fp (Just NoBuffering) False)	
        _ -> constructError "stderr"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -176,18 +168,19 @@ data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
 openFile :: FilePath -> IOMode -> IO Handle
 
 openFile f m = 
-    stToIO (_ccall_ openFile f m')		    >>= \ ptr ->
+    stToIO (_ccall_ openFile f m')		             >>= \ ptr ->
     if ptr /= ``NULL'' then
-        newHandle (htype ptr Nothing False)
+        stToIO (makeForeignObj ptr ((``&freeFile'')::Addr))  >>= \ fp ->
+        newHandle (htype fp Nothing False)
     else
-	stToIO (constructError "openFile")	    >>= \ ioError -> 
+	stToIO (constructError "openFile")	    >>= \ ioError@(IOError hn iot msg) -> 
 	let
 	    improved_error -- a HACK, I guess
-	      = case ioError of
-		  AlreadyExists    msg -> AlreadyExists	   (msg ++ ": " ++ f)
-		  NoSuchThing      msg -> NoSuchThing	   (msg ++ ": " ++ f)
-		  PermissionDenied msg -> PermissionDenied (msg ++ ": " ++ f)
-		  _		       -> ioError
+	      = case iot of
+		  AlreadyExists    -> IOError hn AlreadyExists    (msg ++ ": " ++ f)
+		  NoSuchThing      -> IOError hn NoSuchThing      (msg ++ ": " ++ f)
+		  PermissionDenied -> IOError hn PermissionDenied (msg ++ ": " ++ f)
+		  _		   -> ioError
 	in
         fail improved_error
   where
@@ -238,20 +231,28 @@ hClose handle =
       ErrorHandle ioError ->
 	  fail ioError
       ClosedHandle -> 
-	  fail (IllegalOperation "handle is closed")
+	  ioe_closedHandle handle
       SemiClosedHandle fp (buf,_) ->
           (if buf /= ``NULL'' then
 	      _ccall_ free buf
            else			    
               returnPrimIO ())			    `thenIO_Prim` \ () ->
-          if fp /= ``NULL'' then
-              _ccall_ closeFile fp		    `thenIO_Prim` \ rc ->
-              if rc == 0 then 
+	      _casm_ `` %r = (char *)%0; '' fp      `thenIO_Prim` \ fp_a ->
+              if fp_a /= (``NULL''::Addr) then -- Under what condition can this be NULL?
+                _ccall_ closeFile fp		    `thenIO_Prim` \ rc ->
+	          {- We explicitly close a file object so that we can be told
+	             if there were any errors. Note that after @hClose@
+	             has been performed, the ForeignObj embedded in the Handle
+                     is still lying around in the heap, so care is taken
+                     to avoid closing the file object when the ForeignObj
+	             is finalised. (see freeFile()) -}
+                if rc == 0 then 
 	          return ()
-              else
+                else
 	          constructErrorAndFail "hClose"
-          else			    
-              return ()
+
+              else			    
+                  return ()
       other -> 
           _ccall_ closeFile (filePtr other)	    `thenIO_Prim` \ rc ->
           if rc == 0 then 
@@ -285,10 +286,10 @@ hFileSize handle =
 	  fail ioError
       ClosedHandle -> 
 	  writeHandle handle htype			    >>
-          fail (IllegalOperation "handle is closed")
+	  ioe_closedHandle handle
       SemiClosedHandle _ _ -> 
 	  writeHandle handle htype			    >>
-          fail (IllegalOperation "handle is closed")
+	  ioe_closedHandle handle
       other ->
           -- HACK!  We build a unique MP_INT of the right shape to hold
           -- a single unsigned word, and we let the C routine change the data bits
@@ -322,16 +323,16 @@ hIsEOF handle =
 	  fail ioError
       ClosedHandle -> 
 	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is closed")
+	  ioe_closedHandle handle
       SemiClosedHandle _ _ -> 
 	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is closed")
+	  ioe_closedHandle handle
       WriteHandle _ _ _ -> 
 	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is not open for reading")
+          fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
       AppendHandle _ _ _ -> 
 	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is not open for reading")
+          fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
       other -> 
           _ccall_ fileEOF (filePtr other)	    `thenIO_Prim` \ rc ->
 	  writeHandle handle (markHandle htype)	    >>
@@ -351,62 +352,26 @@ isEOF = hIsEOF stdin
 %*********************************************************
 
 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.
-
-\begin{code}
-data BufferMode  =  NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
-                    deriving (Eq, Ord, Read, Show)
-\end{code}
+block-buffering or no-buffering.  See @IOBase@ for definition
+and further explanation of what the type represent.
 
-Computation $hSetBuffering hdl mode$ sets the mode of buffering for
+Computation @hSetBuffering hdl mode@ sets the mode of buffering for
 handle {\em hdl} on subsequent reads and writes.
 
 \begin{itemize}
 \item
-If {\em mode} is $LineBuffering$, line-buffering should be
+If {\em mode} is @LineBuffering@, line-buffering should be
 enabled if possible.
 \item
-If {\em mode} is $BlockBuffering$ {\em size}, then block-buffering
+If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
 should be enabled if possible.  The size of the buffer is {\em n} items
-if {\em size} is $Just${\em n} and is otherwise implementation-dependent.
+if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
 \item
-If {\em mode} is $NoBuffering$, then buffering is disabled if possible.
+If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
 \end{itemize}
 
-If the buffer mode is changed from $BlockBuffering$ or $LineBuffering$
-to $NoBuffering$, then any items in the output buffer are written to
+If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
+to @NoBuffering@, then any items in the output buffer are written to
 the device, and any items in the input buffer are discarded.  The
 default buffering mode when a handle is opened is
 implementation-dependent and may depend on the object which is
@@ -418,12 +383,14 @@ hSetBuffering :: Handle -> BufferMode -> IO ()
 hSetBuffering handle mode =
     case mode of
       (BlockBuffering (Just n)) 
-        | n <= 0 -> fail (InvalidArgument "illegal buffer size")
+        | n <= 0 -> fail (IOError (Just handle) InvalidArgument "illegal buffer size")
       other ->
 	  readHandle handle			    >>= \ htype ->
           if isMarked htype then
               writeHandle handle htype		    >>
-              fail (UnsupportedOperation "can't set buffering for a dirty handle")
+              fail (IOError (Just handle) 
+			    UnsupportedOperation 
+			    "can't set buffering for a dirty handle")
           else
               case htype of
 	        ErrorHandle ioError ->
@@ -431,10 +398,10 @@ hSetBuffering handle mode =
 	            fail ioError
                 ClosedHandle ->
 		    writeHandle handle htype	    >>
-		    fail (IllegalOperation "handle is closed")
+	            ioe_closedHandle handle
                 SemiClosedHandle _ _ ->
 		    writeHandle handle htype	    >>
-		    fail (IllegalOperation "handle is closed")
+	            ioe_closedHandle handle
                 other ->
                     _ccall_ setBuffering (filePtr other) bsize
 						    `thenIO_Prim` \ rc -> 
@@ -460,7 +427,7 @@ hSetBuffering handle mode =
               BlockBuffering Nothing -> -2
               BlockBuffering (Just n) -> n
 
-    hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
+    hcon :: Handle__ -> (ForeignObj -> (Maybe BufferMode) -> Bool -> Handle__)
     hcon (ReadHandle _ _ _) = ReadHandle
     hcon (WriteHandle _ _ _) = WriteHandle
     hcon (AppendHandle _ _ _) = AppendHandle
@@ -480,10 +447,10 @@ hFlush handle =
 	  fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
 	  _ccall_ flushFile (filePtr other)	    `thenIO_Prim` \ rc ->
 	  writeHandle handle (markHandle htype)   >>
@@ -524,10 +491,10 @@ hGetPosn handle =
 	  fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other -> 
           _ccall_ getFilePosn (filePtr other)      `thenIO_Prim` \ posn ->
           writeHandle handle htype		    >>
@@ -545,13 +512,13 @@ hSetPosn (HandlePosn handle posn) =
 	  fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       AppendHandle _ _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is not seekable")
+	  fail (IOError (Just handle) IllegalOperation "handle is not seekable")
       other -> 
 	  _ccall_ setFilePosn (filePtr other) posn `thenIO_Prim` \ rc ->
 	  writeHandle handle (markHandle htype)    >>
@@ -591,13 +558,13 @@ hSeek handle mode offset@(J# _ s# d#) =
 	  fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       AppendHandle _ _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is not seekable")
+	  fail (IOError (Just handle) IllegalOperation "handle is not seekable")
       other -> 
 	  _ccall_ seekFile (filePtr other) whence (I# s#) (ByteArray (0,0) d#)
                                         	    `thenIO_Prim` \ rc ->
@@ -671,10 +638,10 @@ hIsReadable handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
 	  writeHandle handle htype		    >>
 	  return (isReadable other)
@@ -692,10 +659,10 @@ hIsWritable handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype	    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype	    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
 	  writeHandle handle htype	    >>
 	  return (isWritable other)
@@ -735,10 +702,10 @@ hIsBlockBuffered handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
           getBufferMode other			    `thenIO_Prim` \ other ->
           case bufferMode other of
@@ -760,10 +727,10 @@ hIsLineBuffered handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
 	  getBufferMode other			    `thenIO_Prim` \ other ->
           case bufferMode other of
@@ -785,10 +752,10 @@ hIsNotBuffered handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       other ->
 	  getBufferMode other			    `thenIO_Prim` \ other ->
           case bufferMode other of
@@ -802,23 +769,23 @@ hIsNotBuffered handle =
 		constructErrorAndFail "hIsNotBuffered"
 
 hGetBuffering :: Handle -> IO BufferMode
-hGetBuffering hndl =
-    readHandle hndl				    >>= \ htype ->
+hGetBuffering handle =
+    readHandle handle				    >>= \ htype ->
     case htype of 
       ErrorHandle ioError ->
-	  writeHandle hndl htype		    >>
+	  writeHandle handle htype		    >>
           fail ioError
       ClosedHandle ->
-	  writeHandle hndl htype		    >>
-	  fail (IllegalOperation "handle is closed")
+	  writeHandle handle htype		    >>
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
-	  writeHandle hndl htype		    >>
-	  fail (IllegalOperation "handle is closed")
+	  writeHandle handle htype		    >>
+          ioe_closedHandle handle
       other ->
 	  getBufferMode other			    `thenIO_Prim` \ other ->
           case bufferMode other of
             Just v ->
-	        writeHandle hndl other	            >>
+	        writeHandle handle other            >>
                 return v
     	    Nothing -> 
 		constructErrorAndFail "hGetBuffering"
@@ -832,10 +799,10 @@ hIsSeekable handle =
           fail ioError
       ClosedHandle ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       SemiClosedHandle _ _ ->
 	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
+          ioe_closedHandle handle
       AppendHandle _ _ _ ->
 	  writeHandle handle htype		    >>
 	  return False
@@ -859,10 +826,28 @@ These two functions are meant to get things out of @IOErrors@.  They don't!
 
 \begin{code}
 ioeGetFileName        :: IOError -> Maybe FilePath
+ioeGetErrorString     :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 
+ioeGetHandle   (IOError h _ _)   = h
+ioeGetErrorString (IOError _ iot str) =
+ case iot of
+   EOF -> "end of file"
+   _   -> str
+
+ioeGetFileName (IOError _ _ str) = 
+ case span (/=':') str of
+   (fs,[]) -> Nothing
+   (fs,_)  -> Just fs
 
-ioeGetHandle   _ = Nothing -- a stub, essentially
-ioeGetFileName _ = Nothing -- a stub, essentially
 \end{code}
 
+Internal function for creating an @IOError@ representing the
+access of a closed file.
+
+\begin{code}
+
+ioe_closedHandle :: Handle -> IO a
+ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
+
+\end{code}
diff --git a/ghc/lib/ghc/Main.hi-boot b/ghc/lib/ghc/Main.hi-boot
index 0358a0de22..5eba82e1eb 100644
--- a/ghc/lib/ghc/Main.hi-boot
+++ b/ghc/lib/ghc/Main.hi-boot
@@ -10,4 +10,4 @@ _interface_ Main 1
 _exports_
 Main main ;
 _declarations_
-1 main :: IOBase.IO PrelBase.();;
+1 main _:_ IOBase.IO PrelBase.();;
diff --git a/ghc/lib/ghc/PrelBase.lhs b/ghc/lib/ghc/PrelBase.lhs
index e83a391802..f4a5b1cf3c 100644
--- a/ghc/lib/ghc/PrelBase.lhs
+++ b/ghc/lib/ghc/PrelBase.lhs
@@ -7,7 +7,11 @@
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module PrelBase where
+module PrelBase(
+	module PrelBase,
+	module GHC		-- Re-export GHC, to avoid lots of people having
+				-- to import it explicitly
+  ) where
 
 import {-# SOURCE #-}	IOBase	( error )	
 import GHC
@@ -148,11 +152,7 @@ class  Show a  where
     showsPrec :: Int -> a -> ShowS
     showList  :: [a] -> ShowS
 
-    showList [] = showString "[]"
-    showList (x:xs)
-                = showChar '[' . shows x . showl xs
-                  where showl []     = showChar ']'
-                        showl (x:xs) = showString ", " . shows x . showl xs
+    showList ls = showList__ (showsPrec 0) ls 
 \end{code}
 
 %*********************************************************
@@ -168,8 +168,7 @@ data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 instance (Eq a) => Eq [a]  where
     []     == []     = True	
     (x:xs) == (y:ys) = x == y && xs == ys
-    []     == ys     = False			
-    xs     == []     = False			
+    xs     == ys     = False			
     xs     /= ys     = if (xs == ys) then False else True
 
 instance (Ord a) => Ord [a] where
@@ -195,6 +194,7 @@ instance Functor [] where
 
 instance  Monad []  where
     m >>= k             = foldr ((++) . k) [] m
+    m >> k              = foldr ((++) . (\ _ -> k)) [] m
     return x            = [x]
 
 instance  MonadZero []  where
@@ -205,7 +205,7 @@ instance  MonadPlus []  where
 
 instance  (Show a) => Show [a]  where
     showsPrec p         = showList
-    showList		= showList__ (showsPrec 0)
+    showList  ls	= showList__ (showsPrec 0) ls
 \end{code}
 
 \end{code}
@@ -253,9 +253,12 @@ dropWhile p xs@(x:xs')
 The type @Void@ is built in, but it needs a @Show@ instance.
 
 \begin{code}
+void :: Void
+void = error "You tried to evaluate void"
+
 instance  Show Void  where
     showsPrec p f  =  showString "<<void>>"
-    showList	   = showList__ (showsPrec 0)
+    showList ls    = showList__ (showsPrec 0) ls
 \end{code}
 
 
@@ -272,8 +275,8 @@ data  Bool  =  False | True	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 
 (&&), (||)		:: Bool -> Bool -> Bool
 True  && x		=  x
-False && _		=  False
-True  || _		=  True
+False && x		=  False
+True  || x		=  True
 False || x		=  x
 
 not			:: Bool -> Bool
@@ -294,6 +297,10 @@ otherwise 		=  True
 \begin{code}
 data  Maybe a  =  Nothing | Just a	deriving (Eq, Ord, Show {- Read -})
 
+maybe :: b -> (a -> b) -> Maybe a -> b
+maybe n f Nothing  = n
+maybe n f (Just x) = f x
+
 instance  Functor Maybe  where
     map f Nothing       = Nothing
     map f (Just a)      = Just (f a)
@@ -301,6 +308,10 @@ instance  Functor Maybe  where
 instance  Monad Maybe  where
     (Just x) >>= k      = k x
     Nothing  >>= k      = Nothing
+
+    (Just x) >>  k      = k
+    Nothing  >>  k      = Nothing
+
     return              = Just
 
 instance  MonadZero Maybe  where
@@ -328,7 +339,6 @@ it here seems more direct.
 \begin{code}
 data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
 		 -- (avoids weird-named functions, e.g., con2tag_()#
-
 instance Eq () where
     () == () = True
     () /= () = False
@@ -357,6 +367,7 @@ instance Bounded () where
 
 instance  Show ()  where
     showsPrec p () = showString "()"
+    showList ls    = showList__ (showsPrec 0) ls
 \end{code}
 
 %*********************************************************
@@ -398,11 +409,12 @@ data Char = C# Char#	deriving (Eq, Ord)
 
 instance  Enum Char  where
     toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
-		    | otherwise = error "Prelude.Enum.Char.toEnum:out of range"
+		    | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
     fromEnum (C# c)     	 =  I# (ord# c)
 
     enumFrom (C# c)			   =  eftt (ord# c)  1# 		  255#
     enumFromThen (C# c1) (C# c2)	   =  eftt (ord# c1) (ord# c2 -# ord# c1) 255#
+    enumFromTo (C# c1) (C# c2)             =  eftt (ord# c1) 1#                   (ord# c2)
     enumFromThenTo (C# c1) (C# c2) (C# c3) =  eftt (ord# c1) (ord# c2 -# ord# c1) (ord# c3)
 
 eftt :: Int# -> Int# -> Int# -> [Char]
@@ -428,9 +440,10 @@ instance  Show Char  where
 
 
 \begin{code}
-isAscii, isControl, isPrint, isSpace, isUpper,
+isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
 isAscii c	 	=  fromEnum c < 128
+isLatin1 c              =  c <= '\xff'
 isControl c		=  c < ' ' || c >= '\DEL' && c <= '\x9f'
 isPrint c		=  not (isControl c)
 
@@ -455,19 +468,19 @@ isUpper c		=  c >= 'A' && c <= 'Z' ||
 isLower c		=  c >= 'a' && c <= 'z' ||
                            c >= '\xDF' && c <= '\xF6' ||
                            c >= '\xF8' && c <= '\xFF'
-isAlpha c		=  isUpper c || isLower c
+isAlpha c		=  isLower c || isUpper c
 isDigit c		=  c >= '0' && c <= '9'
 isOctDigit c		=  c >= '0' && c <= '7'
 isHexDigit c		=  isDigit c || c >= 'A' && c <= 'F' ||
                                         c >= 'a' && c <= 'f'
 isAlphanum c		=  isAlpha c || isDigit c
 
--- These almost work for ISO-Latin-1 (except for =DF <-> =FF)
+-- Case-changing operations
 
 toUpper, toLower	:: Char -> Char
-toUpper c | isLower c	=  toEnum (fromEnum c - fromEnum 'a'
-                                              + fromEnum 'A')
-	  | otherwise	=  c
+toUpper c | isLower c	&& c /= '\xDF' && c /= '\xFF'
+ =  toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
+  | otherwise	=  c
 
 toLower c | isUpper c	=  toEnum (fromEnum c - fromEnum 'A' 
                                               + fromEnum 'a')
@@ -491,19 +504,22 @@ asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 data Int = I# Int#
 
 instance Eq Int where
-    (I# x) == (I# y) = x ==# y
+    (==) x y = x `eqInt` y
+    (/=) x y = x `neInt` y
 
 instance Ord Int where
-    (I# x) `compare` (I# y) | x <# y    = LT
-			    | x ==# y   = EQ
-			    | otherwise = GT
-
-    (I# x) <  (I# y) = x <#  y
-    (I# x) <= (I# y) = x <=# y
-    (I# x) >= (I# y) = x >=# y
-    (I# x) >  (I# y) = x >#  y
+    compare x y = compareInt x y 
 
+    (<)  x y = ltInt x y
+    (<=) x y = leInt x y
+    (>=) x y = geInt x y
+    (>)  x y = gtInt x y
+    max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
+    min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
 
+(I# x) `compareInt` (I# y) | x <# y    = LT
+			   | x ==# y   = EQ
+			   | otherwise = GT
 
 instance  Enum Int  where
     toEnum   x = x
@@ -524,6 +540,7 @@ instance  Enum Int  where
     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 				      (enumFromThen n m)
 
+
 instance  Bounded Int where
     minBound =  negate 2147483647   -- **********************
     maxBound =  2147483647	    -- **********************
@@ -546,7 +563,7 @@ instance  Num Int  where
 
 instance  Show Int  where
     showsPrec p n = showSignedInt p n
-    showList      = showList__ (showsPrec 0) 
+    showList ls   = showList__ (showsPrec 0)  ls
 \end{code}
 
 
@@ -576,7 +593,8 @@ data Integer	= J# Int# Int# ByteArray#
 \begin{code}
 instance  Show (a -> b)  where
     showsPrec p f  =  showString "<<function>>"
-    showList	   = showList__ (showsPrec 0)
+    showList ls	   = showList__ (showsPrec 0) ls
+
 
 -- identity function
 id			:: a -> a
@@ -624,6 +642,7 @@ asTypeOf		=  const
 \begin{code}
 data Addr = A# Addr# 	deriving (Eq, Ord) -- Glasgow extension
 data Word = W# Word# 	deriving (Eq, Ord) -- Glasgow extension
+data ForeignObj = ForeignObj ForeignObj#   -- another one
 
 data Lift a = Lift a
 {-# GENERATE_SPECS data a :: Lift a #-}
@@ -727,6 +746,9 @@ Definitions of the boxed PrimOps; these will be
 used in the case of partial applications, etc.
 
 \begin{code}
+{-# INLINE eqInt #-}
+{-# INLINE neInt #-}
+
 plusInt	(I# x) (I# y) = I# (x +# y)
 minusInt(I# x) (I# y) = I# (x -# y)
 timesInt(I# x) (I# y) = I# (x *# y)
diff --git a/ghc/lib/ghc/PrelNum.lhs b/ghc/lib/ghc/PrelNum.lhs
index 940a57b73a..cadad79d5e 100644
--- a/ghc/lib/ghc/PrelNum.lhs
+++ b/ghc/lib/ghc/PrelNum.lhs
@@ -21,6 +21,8 @@ module PrelNum where
 import {-# SOURCE #-}	IOBase	( error )
 import PrelList
 import PrelBase
+import ArrBase	( Array, array, (!) )
+import Ix	( Ix(..) )
 import GHC
 
 infixr 8  ^, ^^, **
@@ -338,8 +340,18 @@ instance  Show Integer  where
     showsPrec   x = showSignedInteger x
     showList = showList__ (showsPrec 0) 
 
+instance  Ix Integer  where
+    range (m,n)		=  [m..n]
+    index b@(m,n) i
+	| inRange b i	=  fromInteger (i - m)
+	| otherwise	=  error "Integer.index: Index out of range."
+    inRange (m,n) i	=  m <= i && i <= n
+
 integer_0, integer_1, integer_2, integer_m1 :: Integer
-integer_0 = 0; integer_1 = 1; integer_2 = 2; integer_m1 = -1
+integer_0  = int2Integer# 0#
+integer_1  = int2Integer# 1#
+integer_2  = int2Integer# 2#
+integer_m1 = int2Integer# (negateInt# 1#)
 \end{code}
 
 
@@ -361,7 +373,7 @@ instance Ord Float where
     (F# x) <  (F# y) = x `ltFloat#`  y
     (F# x) <= (F# y) = x `leFloat#`  y
     (F# x) >= (F# y) = x `geFloat#`  y
-    (F# x) >  (F# y) = x `geFloat#`  y
+    (F# x) >  (F# y) = x `gtFloat#`  y
 
 instance  Num Float  where
     (+)		x y 	=  plusFloat x y
@@ -662,7 +674,7 @@ numericEnumFromThen n m	=  iterate (+(m-n)) n
 %*********************************************************
 
 \begin{code}
-data  (Integral a)	=> Ratio a = a :% a  deriving (Eq)
+data  (Integral a)	=> Ratio a = !a :% !a  deriving (Eq)
 type  Rational		=  Ratio Integer
 \end{code}
 
@@ -671,11 +683,19 @@ type  Rational		=  Ratio Integer
 numerator, denominator	:: (Integral a) => Ratio a -> a
 approxRational		:: (RealFrac a) => a -> a -> Rational
 
+\end{code}
+
+\tr{reduce} is a subsidiary function used only in this module .
+It normalises a ratio by dividing both numerator and denominator by
+their greatest common divisor.
 
+\begin{code}
 reduce _ 0		=  error "{Ratio.%}: zero denominator"
 reduce x y		=  (x `quot` d) :% (y `quot` d)
 			   where d = gcd x y
+\end{code}
 
+\begin{code}
 x % y			=  reduce (x * signum y) (abs y)
 
 numerator (x:%y)	=  x
@@ -754,23 +774,27 @@ instance  (Integral a)  => Show (Ratio a)  where
     	    	    	       (shows x . showString " % " . shows y)
 \end{code}
 
-{-
-[In response to a request by simonpj, Joe Fasel writes:]
+[In response to a request for documentation of how fromRational works,
+Joe Fasel writes:] A quite reasonable request!  This code was added to
+the Prelude just before the 1.2 release, when Lennart, working with an
+early version of hbi, noticed that (read . show) was not the identity
+for floating-point numbers.  (There was a one-bit error about half the
+time.)  The original version of the conversion function was in fact
+simply a floating-point divide, as you suggest above. The new version
+is, I grant you, somewhat denser.
 
-A quite reasonable request!  This code was added to the Prelude just
-before the 1.2 release, when Lennart, working with an early version
-of hbi, noticed that (read . show) was not the identity for
-floating-point numbers.	 (There was a one-bit error about half the time.)
-The original version of the conversion function was in fact simply
-a floating-point divide, as you suggest above.	The new version is,
-I grant you, somewhat denser.
+Unfortunately, Joe's code doesn't work!  Here's an example:
 
-How's this?
+main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n")
 
-Joe
--}
+This program prints
+	0.0000000000000000
+instead of
+	1.8217369128763981e-300
 
-\begin{code}
+Lennart's code follows, and it works...
+
+\begin{pseudocode}
 {-# GENERATE_SPECS fromRational__ a{Double#,Double} #-}
 fromRational__ :: (RealFloat a) => Rational -> a
 fromRational__ x = x'
@@ -796,8 +820,76 @@ fromRational__ x = x'
 
 	      (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
 					/ fromInteger (denominator x))
-\end{code}
+\end{pseudocode}
 
+Now, here's Lennart's code.
+
+\begin{code}
+fromRational__ :: (RealFloat a) => Rational -> a
+fromRational__ x = 
+    if x == 0 then encodeFloat 0 0 		-- Handle exceptional cases
+    else if x < 0 then - fromRat' (-x)		-- first.
+    else fromRat' x
+
+-- Conversion process:
+-- Scale the rational number by the RealFloat base until
+-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
+-- Then round the rational to an Integer and encode it with the exponent
+-- that we got from the scaling.
+-- To speed up the scaling process we compute the log2 of the number to get
+-- a first guess of the exponent.
+
+fromRat' :: (RealFloat a) => Rational -> a
+fromRat' x = r
+  where b = floatRadix r
+        p = floatDigits r
+	(minExp0, _) = floatRange r
+	minExp = minExp0 - p		-- the real minimum exponent
+	xMin = toRational (expt b (p-1))
+	xMax = toRational (expt b p)
+	p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
+	f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1
+	(x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)
+	r = encodeFloat (round x') p'
+
+-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.
+scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int)
+scaleRat b minExp xMin xMax p x =
+    if p <= minExp then
+        (x, p)
+    else if x >= xMax then
+        scaleRat b minExp xMin xMax (p+1) (x/b)
+    else if x < xMin  then
+        scaleRat b minExp xMin xMax (p-1) (x*b)
+    else
+        (x, p)
+
+-- Exponentiation with a cache for the most common numbers.
+minExpt = 0::Int
+maxExpt = 1100::Int
+expt :: Integer -> Int -> Integer
+expt base n =
+    if base == 2 && n >= minExpt && n <= maxExpt then
+        expts!n
+    else
+        base^n
+expts :: Array Int Integer
+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
+
+-- Compute the (floor of the) log of i in base b.
+-- Simplest way would be just divide i by b until it's smaller then b, but that would
+-- be very slow!  We are just slightly more clever.
+integerLogBase :: Integer -> Integer -> Int
+integerLogBase b i =
+     if i < b then
+        0
+     else
+	-- Try squaring the base first to cut down the number of divisions.
+        let l = 2 * integerLogBase (b*b) i
+	    doDiv :: Integer -> Int -> Int
+	    doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
+	in  doDiv (i `div` (b^l)) l
+\end{code}
 
 %*********************************************************
 %*							*
diff --git a/ghc/lib/ghc/PrelRead.lhs b/ghc/lib/ghc/PrelRead.lhs
index 683c42bf5a..b8693c55fb 100644
--- a/ghc/lib/ghc/PrelRead.lhs
+++ b/ghc/lib/ghc/PrelRead.lhs
@@ -367,9 +367,10 @@ lex (c:s) | isSingle c = [([c],s)]
               isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"
               isIdChar c =  isAlphanum c || c `elem` "_'"
 
-              lexFracExp ('.':s) = [('.':ds++e,u) | (ds,t) <- lexDigits s,
-                                                    (e,u)  <- lexExp t]
-              lexFracExp s       = [("",s)]
+              lexFracExp ('.':c:cs) | isDigit c
+				    = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),
+                                                       (e,u)  <- lexExp t]
+              lexFracExp s          = [("",s)]
 
               lexExp (e:s) | e `elem` "eE"
                        = [(e:c:ds,u) | (c:t)  <- [s], c `elem` "+-",
diff --git a/ghc/lib/ghc/STBase.lhs b/ghc/lib/ghc/STBase.lhs
index 9cff0920c6..afc3d519a3 100644
--- a/ghc/lib/ghc/STBase.lhs
+++ b/ghc/lib/ghc/STBase.lhs
@@ -54,33 +54,6 @@ returnST = return
 thenST   = (>>=)
 seqST	 = (>>)
 
--- not sure whether to 1.3-ize these or what...
-{-# INLINE returnStrictlyST #-}
-{-# INLINE thenStrictlyST #-}
-{-# INLINE seqStrictlyST #-}
-
-{-# GENERATE_SPECS returnStrictlyST a #-}
-returnStrictlyST :: a -> ST s a
-
-{-# GENERATE_SPECS thenStrictlyST a b #-}
-thenStrictlyST :: ST s a -> (a -> ST s b) -> ST s b
-
-{-# GENERATE_SPECS seqStrictlyST a b #-}
-seqStrictlyST :: ST s a -> ST s b -> ST s b
-
-returnStrictlyST a = ST $ \ s@(S# _) -> (a, s)
-
-thenStrictlyST (ST m) k = ST $ \ s ->	-- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
-    case (m s) of { (r, new_s) ->
-    case (k r) of { ST k2     ->
-    (k2 new_s) }}
-
-seqStrictlyST (ST m) (ST k) = ST $ \ s ->	-- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
-    case (m s) of { (_, new_s) ->
-    (k new_s) }
-
--- BUILT-IN: runST (see Builtin.hs)
-
 unsafeInterleaveST :: ST s a -> ST s a    -- ToDo: put in state-interface.tex
 unsafeInterleaveST (ST m) = ST $ \ s ->
     let