From 7de50399a42ee49b0473b7b6eea2b44a2f941a12 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 5 Feb 2002 17:32:27 +0000
Subject: [PATCH] [project @ 2002-02-05 17:32:24 by simonmar] - Merging from
 ghc/lib/std - Add System.IO.Error - Now builds without
 --make, so we can do -split-objs

---
 Control/Exception.hs                   |    5 +-
 Data/Array/IO.hs                       |    4 +-
 Data/Bits.hs                           |    4 +-
 Foreign/C/Error.hs                     |  202 ++++++++++-----------
 Foreign/C/Types.hs                     |   13 +-
 Foreign/C/TypesISO.hs                  |    8 +-
 Foreign/Marshal/Alloc.hs               |    8 +-
 Foreign/Marshal/Array.hs               |   32 +---
 Foreign/Marshal/Utils.hs               |   15 +-
 Foreign/Storable.hs                    |    5 +-
 GHC/Base.lhs                           |   52 ++++--
 GHC/Enum.lhs                           |   54 +++---
 GHC/Exception.lhs                      |    3 +-
 GHC/Float.lhs                          |   26 +--
 GHC/Handle.hs                          |   89 ++++------
 GHC/IO.hs                              |   19 +-
 GHC/IOBase.lhs                         |   96 +++++-----
 GHC/List.lhs                           |   68 +++-----
 GHC/Num.lhs                            |   28 ++-
 GHC/{Posix.hsc => Posix.hs}            |  269 ++++++++++++++--------------
 GHC/Storable.lhs                       |   11 +-
 GHC/TopHandler.lhs                     |    5 +-
 GHC/Word.lhs                           |   96 +++++-----
 Makefile                               |    3 +-
 Numeric.hs                             |   20 +--
 System/{Directory.hsc => Directory.hs} |  122 +++++++------
 System/IO.hs                           |    3 +-
 System/IO/Error.hs                     |  186 ++++++++++++++++++++
 System/Time.hsc                        |    4 +-
 cbits/dirUtils.c                       |   97 +++++------
 core.conf.in                           |   13 +-
 include/HsCore.h                       |  300 +++++++++++++++++++++++++++++++-
 include/dirUtils.h                     |   31 +---
 33 files changed, 1141 insertions(+), 750 deletions(-)
 rename GHC/{Posix.hsc => Posix.hs} (50%)
 rename System/{Directory.hsc => Directory.hs} (87%)
 create mode 100644 System/IO/Error.hs

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 529d364..0248ff2 100644
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Exception.hs,v 1.5 2001/12/21 15:07:21 simonmar Exp $
+-- $Id: Exception.hs,v 1.6 2002/02/05 17:32:25 simonmar Exp $
 --
 -- The External API for exceptions.  The functions provided in this
 -- module allow catching of exceptions in the IO monad.
@@ -76,6 +76,7 @@ module Control.Exception (
 
 #ifdef __GLASGOW_HASKELL__
 import Prelude 		hiding (catch)
+import System.IO.Error
 import GHC.Base		( assert )
 import GHC.Exception 	hiding (try, catch, bracket, bracket_)
 import GHC.Conc		( throwTo, ThreadId )
@@ -199,7 +200,7 @@ dynExceptions _ = Nothing
 asyncExceptions (AsyncException e) = Just e
 asyncExceptions _ = Nothing
 
-userErrors (UserError e) = Just e
+userErrors e | isUserError e = Just (ioeGetErrorString e)
 userErrors _ = Nothing
 
 -----------------------------------------------------------------------------
diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs
index f4faa52..af15696 100644
--- a/Data/Array/IO.hs
+++ b/Data/Array/IO.hs
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: IO.hs,v 1.3 2002/01/02 14:40:10 simonmar Exp $
+-- $Id: IO.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Mutable boxed/unboxed arrays in the IO monad.
 --
@@ -407,7 +407,7 @@ readChunk fd is_stream ptr init_off bytes = loop init_off bytes
   loop off bytes | bytes <= 0 = return (off - init_off)
   loop off bytes = do
     r' <- throwErrnoIfMinus1RetryMayBlock "readChunk"
-	    (read_off (fromIntegral fd) is_stream ptr 
+	    (read_off_ba (fromIntegral fd) is_stream ptr 
 		(fromIntegral off) (fromIntegral bytes))
 	    (threadWaitRead fd)
     let r = fromIntegral r'
diff --git a/Data/Bits.hs b/Data/Bits.hs
index 8303545..c68ec75 100644
--- a/Data/Bits.hs
+++ b/Data/Bits.hs
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Bits.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
+-- $Id: Bits.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Bitwise operations.
 --
@@ -50,7 +50,7 @@ import GHC.Base
 --     Removing all fixities is a fairly safe fix; fixing the "one fixity
 --     per symbol per program" limitation in Hugs would take a lot longer.
 #ifndef __HUGS__
-infixl 8 `shift`, `rotate`
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
 infixl 7 .&.
 infixl 6 `xor`
 infixl 5 .|.
diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs
index b0d3a91..77aa36c 100644
--- a/Foreign/C/Error.hs
+++ b/Foreign/C/Error.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Error.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
+-- $Id: Error.hs,v 1.5 2002/02/05 17:32:25 simonmar Exp $
 --
 -- C-specific Marshalling support: Handling of C "errno" error codes
 --
@@ -121,7 +121,7 @@ import System.IO		( IOError, Handle, ioError )
 -- This function exists because errno is a variable on some systems, but on
 -- Windows it is a macro for a function...
 -- [yes, global variables and thread safety don't really go hand-in-hand. -- sof]
-foreign import "ghcErrno" unsafe _errno :: Ptr CInt
+foreign import ccall unsafe "ghcErrno" _errno :: Ptr CInt
 
 -- Haskell representation for "errno" values
 --
@@ -513,107 +513,107 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
     return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
 #endif
 
-foreign import unsafe strerror :: Errno -> IO (Ptr CChar)
+foreign import ccall unsafe strerror :: Errno -> IO (Ptr CChar)
 
 
 -- Dreadfully tedious callouts to wrappers which define  the
 -- actual values for the error codes.
-foreign import ccall "prel_error_E2BIG" unsafe cCONST_E2BIG :: CInt
-foreign import ccall "prel_error_EACCES" unsafe cCONST_EACCES :: CInt
-foreign import ccall "prel_error_EADDRINUSE" unsafe cCONST_EADDRINUSE :: CInt
-foreign import ccall "prel_error_EADDRNOTAVAIL" unsafe cCONST_EADDRNOTAVAIL :: CInt
-foreign import ccall "prel_error_EADV" unsafe cCONST_EADV :: CInt
-foreign import ccall "prel_error_EAFNOSUPPORT" unsafe cCONST_EAFNOSUPPORT :: CInt
-foreign import ccall "prel_error_EAGAIN" unsafe cCONST_EAGAIN :: CInt
-foreign import ccall "prel_error_EALREADY" unsafe cCONST_EALREADY :: CInt
-foreign import ccall "prel_error_EBADF" unsafe cCONST_EBADF :: CInt
-foreign import ccall "prel_error_EBADMSG" unsafe cCONST_EBADMSG :: CInt
-foreign import ccall "prel_error_EBADRPC" unsafe cCONST_EBADRPC :: CInt
-foreign import ccall "prel_error_EBUSY" unsafe cCONST_EBUSY :: CInt
-foreign import ccall "prel_error_ECHILD" unsafe cCONST_ECHILD :: CInt
-foreign import ccall "prel_error_ECOMM" unsafe cCONST_ECOMM :: CInt
-foreign import ccall "prel_error_ECONNABORTED" unsafe cCONST_ECONNABORTED :: CInt
-foreign import ccall "prel_error_ECONNREFUSED" unsafe cCONST_ECONNREFUSED :: CInt
-foreign import ccall "prel_error_ECONNRESET" unsafe cCONST_ECONNRESET :: CInt
-foreign import ccall "prel_error_EDEADLK" unsafe cCONST_EDEADLK :: CInt
-foreign import ccall "prel_error_EDESTADDRREQ" unsafe cCONST_EDESTADDRREQ :: CInt
-foreign import ccall "prel_error_EDIRTY" unsafe cCONST_EDIRTY :: CInt
-foreign import ccall "prel_error_EDOM" unsafe cCONST_EDOM :: CInt
-foreign import ccall "prel_error_EDQUOT" unsafe cCONST_EDQUOT :: CInt
-foreign import ccall "prel_error_EEXIST" unsafe cCONST_EEXIST :: CInt
-foreign import ccall "prel_error_EFAULT" unsafe cCONST_EFAULT :: CInt
-foreign import ccall "prel_error_EFBIG" unsafe cCONST_EFBIG :: CInt
-foreign import ccall "prel_error_EFTYPE" unsafe cCONST_EFTYPE :: CInt
-foreign import ccall "prel_error_EHOSTDOWN" unsafe cCONST_EHOSTDOWN :: CInt
-foreign import ccall "prel_error_EHOSTUNREACH" unsafe cCONST_EHOSTUNREACH :: CInt
-foreign import ccall "prel_error_EIDRM" unsafe cCONST_EIDRM :: CInt
-foreign import ccall "prel_error_EILSEQ" unsafe cCONST_EILSEQ :: CInt
-foreign import ccall "prel_error_EINPROGRESS" unsafe cCONST_EINPROGRESS :: CInt
-foreign import ccall "prel_error_EINTR" unsafe cCONST_EINTR :: CInt
-foreign import ccall "prel_error_EINVAL" unsafe cCONST_EINVAL :: CInt
-foreign import ccall "prel_error_EIO" unsafe cCONST_EIO :: CInt
-foreign import ccall "prel_error_EISCONN" unsafe cCONST_EISCONN :: CInt
-foreign import ccall "prel_error_EISDIR" unsafe cCONST_EISDIR :: CInt
-foreign import ccall "prel_error_ELOOP" unsafe cCONST_ELOOP :: CInt
-foreign import ccall "prel_error_EMFILE" unsafe cCONST_EMFILE :: CInt
-foreign import ccall "prel_error_EMLINK" unsafe cCONST_EMLINK :: CInt
-foreign import ccall "prel_error_EMSGSIZE" unsafe cCONST_EMSGSIZE :: CInt
-foreign import ccall "prel_error_EMULTIHOP" unsafe cCONST_EMULTIHOP :: CInt
-foreign import ccall "prel_error_ENAMETOOLONG" unsafe cCONST_ENAMETOOLONG :: CInt
-foreign import ccall "prel_error_ENETDOWN" unsafe cCONST_ENETDOWN :: CInt
-foreign import ccall "prel_error_ENETRESET" unsafe cCONST_ENETRESET :: CInt
-foreign import ccall "prel_error_ENETUNREACH" unsafe cCONST_ENETUNREACH :: CInt
-foreign import ccall "prel_error_ENFILE" unsafe cCONST_ENFILE :: CInt
-foreign import ccall "prel_error_ENOBUFS" unsafe cCONST_ENOBUFS :: CInt
-foreign import ccall "prel_error_ENODATA" unsafe cCONST_ENODATA :: CInt
-foreign import ccall "prel_error_ENODEV" unsafe cCONST_ENODEV :: CInt
-foreign import ccall "prel_error_ENOENT" unsafe cCONST_ENOENT :: CInt
-foreign import ccall "prel_error_ENOEXEC" unsafe cCONST_ENOEXEC :: CInt
-foreign import ccall "prel_error_ENOLCK" unsafe cCONST_ENOLCK :: CInt
-foreign import ccall "prel_error_ENOLINK" unsafe cCONST_ENOLINK :: CInt
-foreign import ccall "prel_error_ENOMEM" unsafe cCONST_ENOMEM :: CInt
-foreign import ccall "prel_error_ENOMSG" unsafe cCONST_ENOMSG :: CInt
-foreign import ccall "prel_error_ENONET" unsafe cCONST_ENONET :: CInt
-foreign import ccall "prel_error_ENOPROTOOPT" unsafe cCONST_ENOPROTOOPT :: CInt
-foreign import ccall "prel_error_ENOSPC" unsafe cCONST_ENOSPC :: CInt
-foreign import ccall "prel_error_ENOSR" unsafe cCONST_ENOSR :: CInt
-foreign import ccall "prel_error_ENOSTR" unsafe cCONST_ENOSTR :: CInt
-foreign import ccall "prel_error_ENOSYS" unsafe cCONST_ENOSYS :: CInt
-foreign import ccall "prel_error_ENOTBLK" unsafe cCONST_ENOTBLK :: CInt
-foreign import ccall "prel_error_ENOTCONN" unsafe cCONST_ENOTCONN :: CInt
-foreign import ccall "prel_error_ENOTDIR" unsafe cCONST_ENOTDIR :: CInt
-foreign import ccall "prel_error_ENOTEMPTY" unsafe cCONST_ENOTEMPTY :: CInt
-foreign import ccall "prel_error_ENOTSOCK" unsafe cCONST_ENOTSOCK :: CInt
-foreign import ccall "prel_error_ENOTTY" unsafe cCONST_ENOTTY :: CInt
-foreign import ccall "prel_error_ENXIO" unsafe cCONST_ENXIO :: CInt
-foreign import ccall "prel_error_EOPNOTSUPP" unsafe cCONST_EOPNOTSUPP :: CInt
-foreign import ccall "prel_error_EPERM" unsafe cCONST_EPERM :: CInt
-foreign import ccall "prel_error_EPFNOSUPPORT" unsafe cCONST_EPFNOSUPPORT :: CInt
-foreign import ccall "prel_error_EPIPE" unsafe cCONST_EPIPE :: CInt
-foreign import ccall "prel_error_EPROCLIM" unsafe cCONST_EPROCLIM :: CInt
-foreign import ccall "prel_error_EPROCUNAVAIL" unsafe cCONST_EPROCUNAVAIL :: CInt
-foreign import ccall "prel_error_EPROGMISMATCH" unsafe cCONST_EPROGMISMATCH :: CInt
-foreign import ccall "prel_error_EPROGUNAVAIL" unsafe cCONST_EPROGUNAVAIL :: CInt
-foreign import ccall "prel_error_EPROTO" unsafe cCONST_EPROTO :: CInt
-foreign import ccall "prel_error_EPROTONOSUPPORT" unsafe cCONST_EPROTONOSUPPORT :: CInt
-foreign import ccall "prel_error_EPROTOTYPE" unsafe cCONST_EPROTOTYPE :: CInt
-foreign import ccall "prel_error_ERANGE" unsafe cCONST_ERANGE :: CInt
-foreign import ccall "prel_error_EREMCHG" unsafe cCONST_EREMCHG :: CInt
-foreign import ccall "prel_error_EREMOTE" unsafe cCONST_EREMOTE :: CInt
-foreign import ccall "prel_error_EROFS" unsafe cCONST_EROFS :: CInt
-foreign import ccall "prel_error_ERPCMISMATCH" unsafe cCONST_ERPCMISMATCH :: CInt
-foreign import ccall "prel_error_ERREMOTE" unsafe cCONST_ERREMOTE :: CInt
-foreign import ccall "prel_error_ESHUTDOWN" unsafe cCONST_ESHUTDOWN :: CInt
-foreign import ccall "prel_error_ESOCKTNOSUPPORT" unsafe cCONST_ESOCKTNOSUPPORT :: CInt
-foreign import ccall "prel_error_ESPIPE" unsafe cCONST_ESPIPE :: CInt
-foreign import ccall "prel_error_ESRCH" unsafe cCONST_ESRCH :: CInt
-foreign import ccall "prel_error_ESRMNT" unsafe cCONST_ESRMNT :: CInt
-foreign import ccall "prel_error_ESTALE" unsafe cCONST_ESTALE :: CInt
-foreign import ccall "prel_error_ETIME" unsafe cCONST_ETIME :: CInt
-foreign import ccall "prel_error_ETIMEDOUT" unsafe cCONST_ETIMEDOUT :: CInt
-foreign import ccall "prel_error_ETOOMANYREFS" unsafe cCONST_ETOOMANYREFS :: CInt
-foreign import ccall "prel_error_ETXTBSY" unsafe cCONST_ETXTBSY :: CInt
-foreign import ccall "prel_error_EUSERS" unsafe cCONST_EUSERS :: CInt
-foreign import ccall "prel_error_EWOULDBLOCK" unsafe cCONST_EWOULDBLOCK :: CInt
-foreign import ccall "prel_error_EXDEV" unsafe cCONST_EXDEV :: CInt
+foreign import ccall unsafe "prel_error_E2BIG" cCONST_E2BIG :: CInt
+foreign import ccall unsafe "prel_error_EACCES" cCONST_EACCES :: CInt
+foreign import ccall unsafe "prel_error_EADDRINUSE" cCONST_EADDRINUSE :: CInt
+foreign import ccall unsafe "prel_error_EADDRNOTAVAIL" cCONST_EADDRNOTAVAIL :: CInt
+foreign import ccall unsafe "prel_error_EADV" cCONST_EADV :: CInt
+foreign import ccall unsafe "prel_error_EAFNOSUPPORT" cCONST_EAFNOSUPPORT :: CInt
+foreign import ccall unsafe "prel_error_EAGAIN" cCONST_EAGAIN :: CInt
+foreign import ccall unsafe "prel_error_EALREADY" cCONST_EALREADY :: CInt
+foreign import ccall unsafe "prel_error_EBADF" cCONST_EBADF :: CInt
+foreign import ccall unsafe "prel_error_EBADMSG" cCONST_EBADMSG :: CInt
+foreign import ccall unsafe "prel_error_EBADRPC" cCONST_EBADRPC :: CInt
+foreign import ccall unsafe "prel_error_EBUSY" cCONST_EBUSY :: CInt
+foreign import ccall unsafe "prel_error_ECHILD" cCONST_ECHILD :: CInt
+foreign import ccall unsafe "prel_error_ECOMM" cCONST_ECOMM :: CInt
+foreign import ccall unsafe "prel_error_ECONNABORTED" cCONST_ECONNABORTED :: CInt
+foreign import ccall unsafe "prel_error_ECONNREFUSED" cCONST_ECONNREFUSED :: CInt
+foreign import ccall unsafe "prel_error_ECONNRESET" cCONST_ECONNRESET :: CInt
+foreign import ccall unsafe "prel_error_EDEADLK" cCONST_EDEADLK :: CInt
+foreign import ccall unsafe "prel_error_EDESTADDRREQ" cCONST_EDESTADDRREQ :: CInt
+foreign import ccall unsafe "prel_error_EDIRTY" cCONST_EDIRTY :: CInt
+foreign import ccall unsafe "prel_error_EDOM" cCONST_EDOM :: CInt
+foreign import ccall unsafe "prel_error_EDQUOT" cCONST_EDQUOT :: CInt
+foreign import ccall unsafe "prel_error_EEXIST" cCONST_EEXIST :: CInt
+foreign import ccall unsafe "prel_error_EFAULT" cCONST_EFAULT :: CInt
+foreign import ccall unsafe "prel_error_EFBIG" cCONST_EFBIG :: CInt
+foreign import ccall unsafe "prel_error_EFTYPE" cCONST_EFTYPE :: CInt
+foreign import ccall unsafe "prel_error_EHOSTDOWN" cCONST_EHOSTDOWN :: CInt
+foreign import ccall unsafe "prel_error_EHOSTUNREACH" cCONST_EHOSTUNREACH :: CInt
+foreign import ccall unsafe "prel_error_EIDRM" cCONST_EIDRM :: CInt
+foreign import ccall unsafe "prel_error_EILSEQ" cCONST_EILSEQ :: CInt
+foreign import ccall unsafe "prel_error_EINPROGRESS" cCONST_EINPROGRESS :: CInt
+foreign import ccall unsafe "prel_error_EINTR" cCONST_EINTR :: CInt
+foreign import ccall unsafe "prel_error_EINVAL" cCONST_EINVAL :: CInt
+foreign import ccall unsafe "prel_error_EIO" cCONST_EIO :: CInt
+foreign import ccall unsafe "prel_error_EISCONN" cCONST_EISCONN :: CInt
+foreign import ccall unsafe "prel_error_EISDIR" cCONST_EISDIR :: CInt
+foreign import ccall unsafe "prel_error_ELOOP" cCONST_ELOOP :: CInt
+foreign import ccall unsafe "prel_error_EMFILE" cCONST_EMFILE :: CInt
+foreign import ccall unsafe "prel_error_EMLINK" cCONST_EMLINK :: CInt
+foreign import ccall unsafe "prel_error_EMSGSIZE" cCONST_EMSGSIZE :: CInt
+foreign import ccall unsafe "prel_error_EMULTIHOP" cCONST_EMULTIHOP :: CInt
+foreign import ccall unsafe "prel_error_ENAMETOOLONG" cCONST_ENAMETOOLONG :: CInt
+foreign import ccall unsafe "prel_error_ENETDOWN" cCONST_ENETDOWN :: CInt
+foreign import ccall unsafe "prel_error_ENETRESET" cCONST_ENETRESET :: CInt
+foreign import ccall unsafe "prel_error_ENETUNREACH" cCONST_ENETUNREACH :: CInt
+foreign import ccall unsafe "prel_error_ENFILE" cCONST_ENFILE :: CInt
+foreign import ccall unsafe "prel_error_ENOBUFS" cCONST_ENOBUFS :: CInt
+foreign import ccall unsafe "prel_error_ENODATA" cCONST_ENODATA :: CInt
+foreign import ccall unsafe "prel_error_ENODEV" cCONST_ENODEV :: CInt
+foreign import ccall unsafe "prel_error_ENOENT" cCONST_ENOENT :: CInt
+foreign import ccall unsafe "prel_error_ENOEXEC" cCONST_ENOEXEC :: CInt
+foreign import ccall unsafe "prel_error_ENOLCK" cCONST_ENOLCK :: CInt
+foreign import ccall unsafe "prel_error_ENOLINK" cCONST_ENOLINK :: CInt
+foreign import ccall unsafe "prel_error_ENOMEM" cCONST_ENOMEM :: CInt
+foreign import ccall unsafe "prel_error_ENOMSG" cCONST_ENOMSG :: CInt
+foreign import ccall unsafe "prel_error_ENONET" cCONST_ENONET :: CInt
+foreign import ccall unsafe "prel_error_ENOPROTOOPT" cCONST_ENOPROTOOPT :: CInt
+foreign import ccall unsafe "prel_error_ENOSPC" cCONST_ENOSPC :: CInt
+foreign import ccall unsafe "prel_error_ENOSR" cCONST_ENOSR :: CInt
+foreign import ccall unsafe "prel_error_ENOSTR" cCONST_ENOSTR :: CInt
+foreign import ccall unsafe "prel_error_ENOSYS" cCONST_ENOSYS :: CInt
+foreign import ccall unsafe "prel_error_ENOTBLK" cCONST_ENOTBLK :: CInt
+foreign import ccall unsafe "prel_error_ENOTCONN" cCONST_ENOTCONN :: CInt
+foreign import ccall unsafe "prel_error_ENOTDIR" cCONST_ENOTDIR :: CInt
+foreign import ccall unsafe "prel_error_ENOTEMPTY" cCONST_ENOTEMPTY :: CInt
+foreign import ccall unsafe "prel_error_ENOTSOCK" cCONST_ENOTSOCK :: CInt
+foreign import ccall unsafe "prel_error_ENOTTY" cCONST_ENOTTY :: CInt
+foreign import ccall unsafe "prel_error_ENXIO" cCONST_ENXIO :: CInt
+foreign import ccall unsafe "prel_error_EOPNOTSUPP" cCONST_EOPNOTSUPP :: CInt
+foreign import ccall unsafe "prel_error_EPERM" cCONST_EPERM :: CInt
+foreign import ccall unsafe "prel_error_EPFNOSUPPORT" cCONST_EPFNOSUPPORT :: CInt
+foreign import ccall unsafe "prel_error_EPIPE" cCONST_EPIPE :: CInt
+foreign import ccall unsafe "prel_error_EPROCLIM" cCONST_EPROCLIM :: CInt
+foreign import ccall unsafe "prel_error_EPROCUNAVAIL" cCONST_EPROCUNAVAIL :: CInt
+foreign import ccall unsafe "prel_error_EPROGMISMATCH" cCONST_EPROGMISMATCH :: CInt
+foreign import ccall unsafe "prel_error_EPROGUNAVAIL" cCONST_EPROGUNAVAIL :: CInt
+foreign import ccall unsafe "prel_error_EPROTO" cCONST_EPROTO :: CInt
+foreign import ccall unsafe "prel_error_EPROTONOSUPPORT" cCONST_EPROTONOSUPPORT :: CInt
+foreign import ccall unsafe "prel_error_EPROTOTYPE" cCONST_EPROTOTYPE :: CInt
+foreign import ccall unsafe "prel_error_ERANGE" cCONST_ERANGE :: CInt
+foreign import ccall unsafe "prel_error_EREMCHG" cCONST_EREMCHG :: CInt
+foreign import ccall unsafe "prel_error_EREMOTE" cCONST_EREMOTE :: CInt
+foreign import ccall unsafe "prel_error_EROFS" cCONST_EROFS :: CInt
+foreign import ccall unsafe "prel_error_ERPCMISMATCH" cCONST_ERPCMISMATCH :: CInt
+foreign import ccall unsafe "prel_error_ERREMOTE" cCONST_ERREMOTE :: CInt
+foreign import ccall unsafe "prel_error_ESHUTDOWN" cCONST_ESHUTDOWN :: CInt
+foreign import ccall unsafe "prel_error_ESOCKTNOSUPPORT" cCONST_ESOCKTNOSUPPORT :: CInt
+foreign import ccall unsafe "prel_error_ESPIPE" cCONST_ESPIPE :: CInt
+foreign import ccall unsafe "prel_error_ESRCH" cCONST_ESRCH :: CInt
+foreign import ccall unsafe "prel_error_ESRMNT" cCONST_ESRMNT :: CInt
+foreign import ccall unsafe "prel_error_ESTALE" cCONST_ESTALE :: CInt
+foreign import ccall unsafe "prel_error_ETIME" cCONST_ETIME :: CInt
+foreign import ccall unsafe "prel_error_ETIMEDOUT" cCONST_ETIMEDOUT :: CInt
+foreign import ccall unsafe "prel_error_ETOOMANYREFS" cCONST_ETOOMANYREFS :: CInt
+foreign import ccall unsafe "prel_error_ETXTBSY" cCONST_ETXTBSY :: CInt
+foreign import ccall unsafe "prel_error_EUSERS" cCONST_EUSERS :: CInt
+foreign import ccall unsafe "prel_error_EWOULDBLOCK" cCONST_EWOULDBLOCK :: CInt
+foreign import ccall unsafe "prel_error_EXDEV" cCONST_EXDEV :: CInt
 
diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index 744d448..eaffa3c 100644
--- a/Foreign/C/Types.hs
+++ b/Foreign/C/Types.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Types.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: Types.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Mapping of C types to corresponding Haskell types. A cool hack...
 --
@@ -18,13 +18,14 @@
 module Foreign.C.Types
 	( -- Integral types, instances of: Eq, Ord, Num, Read, Show, Enum,
 	  -- Typeable, Storable, Bounded, Real, Integral, Bits
-	  CChar(..),    CSChar(..),  CUChar(..)
-	, CShort(..),   CUShort(..), CInt(..),    CUInt(..)
-	, CLong(..),    CULong(..),  CLLong(..),  CULLong(..)
+	  CChar(..),  CSChar(..),  CUChar(..)
+	, CShort(..), CUShort(..), CInt(..),   CUInt(..)
+	, CLong(..),  CULong(..),  CLLong(..), CULLong(..)
 
 	  -- Floating types, instances of: Eq, Ord, Num, Read, Show, Enum,
-	  -- Typeable, Storable, Real, Fractional, Floating, RealFrac, RealFloat
-	, CFloat(..),   CDouble(..), CLDouble(..)
+	  -- Typeable, Storable, Real, Fractional, Floating, RealFrac,
+	  -- RealFloat 
+	, CFloat(..),  CDouble(..), CLDouble(..)
 	) where
 
 import Data.Bits	( Bits(..) )
diff --git a/Foreign/C/TypesISO.hs b/Foreign/C/TypesISO.hs
index 464d2a7..0ecffdb 100644
--- a/Foreign/C/TypesISO.hs
+++ b/Foreign/C/TypesISO.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: TypesISO.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: TypesISO.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
 --
 -- A mapping of C types defined by the ISO C standard to corresponding Haskell
 -- types. Like CTypes, this is a cool hack...
@@ -25,6 +25,7 @@ module Foreign.C.TypesISO
 	  -- Typeable, Storable
 	, CClock(..),   CTime(..),
 
+          -- Instances of: Eq and Storable
 	, CFile,        CFpos,     CJmpBuf
 	) where
 
@@ -64,12 +65,9 @@ INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T)
 INTEGRAL_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
 INTEGRAL_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
 
--- TODO: Instances. But which...?  :-}
-
+-- FIXME: Implement and provide instances for Eq and Storable
 data CFile = CFile
-
 data CFpos = CFpos
-
 data CJmpBuf = CJmpBuf
 
 -- C99 types which are still missing include:
diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs
index 6080d0c..706b4b0 100644
--- a/Foreign/Marshal/Alloc.hs
+++ b/Foreign/Marshal/Alloc.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Alloc.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
+-- $Id: Alloc.hs,v 1.5 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Marshalling support: basic routines for memory allocation
 --
@@ -124,6 +124,6 @@ failWhenNULL name f = do
 
 -- basic C routines needed for memory allocation
 --
-foreign import "malloc"  unsafe _malloc  ::          CSize -> IO (Ptr a)
-foreign import "realloc" unsafe _realloc :: Ptr a -> CSize -> IO (Ptr a)
-foreign import "free"	 unsafe _free    :: Ptr a -> IO ()
+foreign import ccall unsafe "malloc"  _malloc  ::          CSize -> IO (Ptr a)
+foreign import ccall unsafe "realloc" _realloc :: Ptr a -> CSize -> IO (Ptr a)
+foreign import ccall unsafe "free"    _free    :: Ptr a -> IO ()
diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs
index c660ba1..7b75b23 100644
--- a/Foreign/Marshal/Array.hs
+++ b/Foreign/Marshal/Array.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Array.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: Array.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Marshalling support: routines allocating, storing, and retrieving Haskell
 -- lists that are represented as arrays in the foreign language
@@ -45,11 +45,6 @@ module Foreign.Marshal.Array (
   withArray,      -- :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
   withArray0,     -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
 
-  -- destruction
-  --
-  destructArray,  -- :: Storable a =>         Int -> Ptr a -> IO ()
-  destructArray0, -- :: (Storable a, Eq a) => a   -> Ptr a -> IO ()
-
   -- copying (argument order: destination, source)
   --
   copyArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
@@ -61,14 +56,14 @@ module Foreign.Marshal.Array (
 
   -- indexing
   --
-  advancePtr      -- :: Storable a => Ptr a -> Int -> Ptr a
+  advancePtr,     -- :: Storable a => Ptr a -> Int -> Ptr a
 ) where
 
 import Control.Monad
 
 #ifdef __GLASGOW_HASKELL__
 import Foreign.Ptr	        (Ptr, plusPtr)
-import GHC.Storable     (Storable(sizeOf,peekElemOff,pokeElemOff,destruct))
+import GHC.Storable     (Storable(sizeOf,peekElemOff,pokeElemOff))
 import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes)
 import Foreign.Marshal.Utils (copyBytes, moveBytes)
 import GHC.IOBase
@@ -191,7 +186,6 @@ withArray vals f  =
   allocaArray len $ \ptr -> do
       pokeArray ptr vals
       res <- f ptr
-      destructArray len ptr
       return res
   where
     len = length vals
@@ -203,31 +197,11 @@ withArray0 marker vals f  =
   allocaArray0 len $ \ptr -> do
       pokeArray0 marker ptr vals
       res <- f ptr
-      destructArray (len+1) ptr
       return res
   where
     len = length vals
 
 
--- destruction
--- -----------
-
--- destruct each element of an array (in reverse order)
---
-destructArray          :: Storable a => Int -> Ptr a -> IO ()
-destructArray size ptr  =
-  sequence_ [destruct (ptr `advancePtr` i)
-    | i <- [size-1, size-2 .. 0]]
-
--- like `destructArray', but a terminator indicates where the array ends
---
-destructArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO ()
-destructArray0 marker ptr  = do
-  size <- lengthArray0 marker ptr
-  sequence_ [destruct (ptr `advancePtr` i)
-    | i <- [size, size-1 .. 0]]
-
-
 -- copying (argument order: destination, source)
 -- -------
 
diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs
index b26f969..b6864ca 100644
--- a/Foreign/Marshal/Utils.hs
+++ b/Foreign/Marshal/Utils.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Utils.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: Utils.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
 --
 -- Utilities for primitive marshaling
 --
@@ -52,11 +52,11 @@ import Data.Maybe
 
 #ifdef __GLASGOW_HASKELL__
 import Foreign.Ptr	        ( Ptr, nullPtr )
-import GHC.Storable	( Storable(poke,destruct) )
-import Foreign.C.TypesISO    ( CSize )
-import Foreign.Marshal.Alloc ( malloc, alloca )
+import GHC.Storable		( Storable(poke) )
+import Foreign.C.TypesISO    	( CSize )
+import Foreign.Marshal.Alloc 	( malloc, alloca )
 import GHC.IOBase
-import GHC.Real		( fromIntegral )
+import GHC.Real			( fromIntegral )
 import GHC.Num
 import GHC.Base
 #endif
@@ -83,7 +83,6 @@ withObject val f  =
   alloca $ \ptr -> do
     poke ptr val
     res <- f ptr
-    destruct ptr
     return res
 
 
@@ -164,5 +163,5 @@ moveBytes dest src size  = memmove dest src (fromIntegral size)
 
 -- basic C routines needed for memory copying
 --
-foreign import unsafe memcpy  :: Ptr a -> Ptr a -> CSize -> IO ()
-foreign import unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO ()
+foreign import ccall unsafe memcpy  :: Ptr a -> Ptr a -> CSize -> IO ()
+foreign import ccall unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO ()
diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs
index 67cbc7b..755b383 100644
--- a/Foreign/Storable.hs
+++ b/Foreign/Storable.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Storable.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: Storable.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
 --
 -- A class for primitive marshaling
 --
@@ -24,8 +24,7 @@ module Foreign.Storable
 	     peekByteOff,    -- :: Ptr b -> Int      -> IO a
 	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
 	     peek,           -- :: Ptr a             -> IO a
-	     poke,           -- :: Ptr a        -> a -> IO ()
-	     destruct)       -- :: Ptr a             -> IO ()
+	     poke)           -- :: Ptr a        -> a -> IO ()
 	) where
 
 #ifdef __GLASGOW_HASKELL__
diff --git a/GHC/Base.lhs b/GHC/Base.lhs
index d9b7908..b4961ae 100644
--- a/GHC/Base.lhs
+++ b/GHC/Base.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Base.lhs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
+% $Id: Base.lhs,v 1.5 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -272,8 +272,10 @@ augment g xs = g (:) xs
 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . 
 		foldr k z (augment g xs) = g k (foldr k z xs)
 
-"foldr/id"    	foldr (:) [] = \x->x
-"foldr/app"    	forall xs ys. foldr (:) ys xs = append xs ys
+"foldr/id"    			  foldr (:) [] = \x->x
+"foldr/app"    	[1] forall xs ys. foldr (:) ys xs = xs ++ ys
+	-- Only activate this from phase 1, because that's
+	-- when we disable the rule that expands (++) into foldr
 
 -- The foldr/cons rule looks nice, but it can give disastrously
 -- bloated code when commpiling
@@ -304,21 +306,36 @@ augment g xs = g (:) xs
 
 \begin{code}
 map :: (a -> b) -> [a] -> [b]
-{-# NOINLINE [1] map #-}
-map = mapList
+map _ []     = []
+map f (x:xs) = f x : map f xs
 
 -- Note eta expanded
 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+{-# INLINE [0] mapFB #-}
 mapFB c f x ys = c (f x) ys
 
-mapList :: (a -> b) -> [a] -> [b]
-mapList _ []     = []
-mapList f (x:xs) = f x : mapList f xs
+-- The rules for map work like this.
+-- 
+-- Up to (but not including) phase 1, we use the "map" rule to
+-- rewrite all saturated applications of map with its build/fold 
+-- form, hoping for fusion to happen.
+-- In phase 1 and 0, we switch off that rule, inline build, and
+-- switch on the "mapList" rule, which rewrites the foldr/mapFB
+-- thing back into plain map.  
+--
+-- It's important that these two rules aren't both active at once 
+-- (along with build's unfolding) else we'd get an infinite loop 
+-- in the rules.  Hence the activation control below.
+--
+-- The "mapFB" rule optimises compositions of map.
+--
+-- This same pattern is followed by many other functions: 
+-- e.g. append, filter, iterate, repeat, etc.
 
 {-# RULES
-"map"	    forall f xs.	map f xs		= build (\c n -> foldr (mapFB c f) n xs)
+"map"	    [~1] forall f xs.	map f xs		= build (\c n -> foldr (mapFB c f) n xs)
+"mapList"   [1]  forall f.	foldr (mapFB (:) f) []	= map f
 "mapFB"	    forall c f g.	mapFB (mapFB c f) g	= mapFB c (f.g) 
-"mapList"   forall f.		foldr (mapFB (:) f) []	= mapList f
   #-}
 \end{code}
 
@@ -328,16 +345,13 @@ mapList f (x:xs) = f x : mapList f xs
 ----------------------------------------------
 \begin{code}
 (++) :: [a] -> [a] -> [a]
-{-# NOINLINE [1] (++) #-}
-(++) = append
+(++) []     ys = ys
+(++) (x:xs) ys = x : xs ++ ys
 
 {-# RULES
-"++"	forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+"++"	[~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
   #-}
 
-append :: [a] -> [a] -> [a]
-append []     ys = ys
-append (x:xs) ys = x : append xs ys
 \end{code}
 
 
@@ -802,9 +816,9 @@ unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 	    ch -> unpack (C# ch : acc) (i# -# 1#)
 
 {-# RULES
-"unpack"	 forall a   . unpackCString# a		   = build (unpackFoldrCString# a)
-"unpack-list"    forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
-"unpack-append"  forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
+"unpack"       [~1] forall a   . unpackCString# a		   = build (unpackFoldrCString# a)
+"unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
+"unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 
 -- There's a built-in rule (in GHC.Rules.lhs) for
 -- 	unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs
index 7e5f9d9..e0a7a4b 100644
--- a/GHC/Enum.lhs
+++ b/GHC/Enum.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Enum.lhs,v 1.6 2001/12/21 15:07:22 simonmar Exp $
+% $Id: Enum.lhs,v 1.7 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -205,20 +205,13 @@ instance  Enum Char  where
     {-# INLINE enumFromThenTo #-}
     enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
 
-{-# NOINLINE [1] eftChar #-}
-{-# NOINLINE [1] efdChar #-}
-{-# NOINLINE [1] efdtChar #-}
-eftChar  = eftCharList
-efdChar  = efdCharList
-efdtChar = efdtCharList
-
 {-# RULES
-"eftChar"	forall x y.	eftChar x y	  = build (\c n -> eftCharFB c n x y)
-"efdChar"	forall x1 x2.	efdChar x1 x2	  = build (\ c n -> efdCharFB c n x1 x2)
-"efdtChar"	forall x1 x2 l.	efdtChar x1 x2 l  = build (\ c n -> efdtCharFB c n x1 x2 l)
-"eftCharList"	eftCharFB  (:) [] = eftCharList
-"efdCharList"	efdCharFB  (:) [] = efdCharList
-"efdtCharList"	efdtCharFB (:) [] = efdtCharList
+"eftChar"	[~1] forall x y.	eftChar x y	  = build (\c n -> eftCharFB c n x y)
+"efdChar"	[~1] forall x1 x2.	efdChar x1 x2	  = build (\ c n -> efdCharFB c n x1 x2)
+"efdtChar"	[~1] forall x1 x2 l.	efdtChar x1 x2 l  = build (\ c n -> efdtCharFB c n x1 x2 l)
+"eftCharList"	[1]  eftCharFB  (:) [] = eftChar
+"efdCharList"	[1]  efdCharFB  (:) [] = efdChar
+"efdtCharList"	[1]  efdtCharFB (:) [] = efdtChar
  #-}
 
 
@@ -230,8 +223,8 @@ eftCharFB c n x y = go x
 		    go x | x ># y    = n
 			 | otherwise = C# (chr# x) `c` go (x +# 1#)
 
-eftCharList x y | x ># y    = [] 
-	        | otherwise = C# (chr# x) : eftCharList (x +# 1#) y
+eftChar x y | x ># y    = [] 
+	        | otherwise = C# (chr# x) : eftChar (x +# 1#) y
 
 
 -- For enumFromThenTo we give up on inlining
@@ -242,7 +235,7 @@ efdCharFB c n x1 x2
   where
     delta = x2 -# x1
 
-efdCharList x1 x2
+efdChar x1 x2
   | delta >=# 0# = go_up_char_list x1 delta 0x10FFFF#
   | otherwise    = go_dn_char_list x1 delta 0#
   where
@@ -255,7 +248,7 @@ efdtCharFB c n x1 x2 lim
   where
     delta = x2 -# x1
 
-efdtCharList x1 x2 lim
+efdtChar x1 x2 lim
   | delta >=# 0# = go_up_char_list x1 delta lim
   | otherwise    = go_dn_char_list x1 delta lim
   where
@@ -330,21 +323,14 @@ instance  Enum Int  where
     {-# INLINE enumFromThenTo #-}
     enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
 
-{-# NOINLINE [1] eftInt #-}
-{-# NOINLINE [1] efdInt #-}
-{-# NOINLINE [1] efdtInt #-}
-eftInt 	= eftIntList
-efdInt 	= efdIntList
-efdtInt = efdtIntList
-
 {-# RULES
-"eftInt"	forall x y.	eftInt x y	 = build (\ c n -> eftIntFB c n x y)
-"efdInt"	forall x1 x2.	efdInt x1 x2	 = build (\ c n -> efdIntFB c n x1 x2)
-"efdtInt"	forall x1 x2 l.	efdtInt x1 x2 l	 = build (\ c n -> efdtIntFB c n x1 x2 l)
+"eftInt"	[~1] forall x y.	eftInt x y	 = build (\ c n -> eftIntFB c n x y)
+"efdInt"	[~1] forall x1 x2.	efdInt x1 x2	 = build (\ c n -> efdIntFB c n x1 x2)
+"efdtInt"	[~1] forall x1 x2 l.	efdtInt x1 x2 l	 = build (\ c n -> efdtIntFB c n x1 x2 l)
 
-"eftIntList"	eftIntFB  (:) [] = eftIntList
-"efdIntList"	efdIntFB  (:) [] = efdIntList
-"efdtIntList"	efdtIntFB (:) [] = efdtIntList
+"eftIntList"	[1] eftIntFB  (:) [] = eftInt
+"efdIntList"	[1] efdIntFB  (:) [] = efdInt
+"efdtIntList"	[1] efdtIntFB (:) [] = efdtInt
  #-}
 
 
@@ -358,7 +344,7 @@ eftIntFB c n x y | x ># y    = n
 	-- so that when eftInfFB is inlined we can inline
 	-- whatver is bound to "c"
 
-eftIntList x y | x ># y    = []
+eftInt x y | x ># y    = []
 	       | otherwise = go x
 	       where
 		 go x = I# x : if x ==# y then [] else go (x +# 1#)
@@ -374,7 +360,7 @@ efdtIntFB c n x1 x2 y
     delta = x2 -# x1
     lim   = y -# delta
 
-efdtIntList x1 x2 y
+efdtInt x1 x2 y
   | delta >=# 0# = if x1 ># y then [] else go_up_int_list x1 delta lim
   | otherwise    = if x1 <# y then [] else go_dn_int_list x1 delta lim
   where
@@ -388,7 +374,7 @@ efdIntFB c n x1 x2
   where
     delta = x2 -# x1
 
-efdIntList x1 x2
+efdInt x1 x2
   | delta >=# 0# = case maxInt of I# y -> go_up_int_list x1 delta (y -# delta)
   | otherwise    = case minInt of I# y -> go_dn_int_list x1 delta (y -# delta)
   where
diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs
index ac7237f..50af792 100644
--- a/GHC/Exception.lhs
+++ b/GHC/Exception.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Exception.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Exception.lhs,v 1.3 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1998-2000
 %
@@ -54,7 +54,6 @@ catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
 catch           :: IO a -> (Exception -> IO a) -> IO a 
 catch m k	=  catchException m handler
   where handler err@(IOException _) = k err
-        handler err@(UserError   _) = k err
 	handler other               = throw other
 \end{code}
 
diff --git a/GHC/Float.lhs b/GHC/Float.lhs
index 6bd7df4..ec27a12 100644
--- a/GHC/Float.lhs
+++ b/GHC/Float.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Float.lhs,v 1.3 2001/12/21 15:07:22 simonmar Exp $
+% $Id: Float.lhs,v 1.4 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -883,27 +883,27 @@ powerDouble  (D# x) (D# y) = D# (x **## y)
 \end{code}
 
 \begin{code}
-foreign import ccall "__encodeFloat" unsafe 
+foreign import ccall unsafe "__encodeFloat"
 	encodeFloat# :: Int# -> ByteArray# -> Int -> Float
-foreign import ccall "__int_encodeFloat" unsafe 
+foreign import ccall unsafe "__int_encodeFloat"
 	int_encodeFloat# :: Int# -> Int -> Float
 
 
-foreign import ccall "isFloatNaN" unsafe isFloatNaN :: Float -> Int
-foreign import ccall "isFloatInfinite" unsafe isFloatInfinite :: Float -> Int
-foreign import ccall "isFloatDenormalized" unsafe isFloatDenormalized :: Float -> Int
-foreign import ccall "isFloatNegativeZero" unsafe isFloatNegativeZero :: Float -> Int
+foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
+foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
+foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
+foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
 
 
-foreign import ccall "__encodeDouble" unsafe 
+foreign import ccall unsafe "__encodeDouble"
 	encodeDouble# :: Int# -> ByteArray# -> Int -> Double
-foreign import ccall "__int_encodeDouble" unsafe 
+foreign import ccall unsafe "__int_encodeDouble"
 	int_encodeDouble# :: Int# -> Int -> Double
 
-foreign import ccall "isDoubleNaN" unsafe isDoubleNaN :: Double -> Int
-foreign import ccall "isDoubleInfinite" unsafe isDoubleInfinite :: Double -> Int
-foreign import ccall "isDoubleDenormalized" unsafe isDoubleDenormalized :: Double -> Int
-foreign import ccall "isDoubleNegativeZero" unsafe isDoubleNegativeZero :: Double -> Int
+foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
+foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
+foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
+foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
 \end{code}
 
 %*********************************************************
diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 1b9a92a..db9e886 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: Handle.hs,v 1.2 2002/01/02 14:40:10 simonmar Exp $
+-- $Id: Handle.hs,v 1.3 2002/02/05 17:32:26 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -16,7 +16,8 @@ module GHC.Handle (
   
   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
-  read_off,
+  read_off,  read_off_ba,
+  write_off, write_off_ba,
 
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
@@ -32,7 +33,6 @@ module GHC.Handle (
 
   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
   hSetEcho, hGetEcho, hIsTerminalDevice,
-  ioeGetFileName, ioeGetErrorString, ioeGetHandle, 
 
 #ifdef DEBUG_DUMP
   puts,
@@ -45,6 +45,7 @@ import Data.Bits
 import Data.Maybe
 import Foreign
 import Foreign.C
+import System.IO.Error
 
 import GHC.Posix
 import GHC.Real
@@ -416,17 +417,19 @@ flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
      then return (buf{ bufRPtr=0, bufWPtr=0 })
      else do
   res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
-		(write_off (fromIntegral fd) is_stream b (fromIntegral r)
-			(fromIntegral bytes))
+		(write_off_ba (fromIntegral fd) is_stream b (fromIntegral r)
+			      (fromIntegral bytes))
 		(threadWaitWrite fd)
   let res' = fromIntegral res
   if res' < bytes 
      then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
      else return buf{ bufRPtr=0, bufWPtr=0 }
 
-foreign import "__hscore_PrelHandle_write" unsafe
-   write_off :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+foreign import ccall unsafe "__hscore_PrelHandle_write"
+   write_off_ba :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 
+foreign import ccall unsafe "__hscore_PrelHandle_write"
+   write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 
 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
 fillReadBuffer fd is_line is_stream
@@ -450,7 +453,7 @@ fillReadBufferLoop fd is_line is_stream buf b w size = do
   puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
 #endif
   res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
-	    (read_off fd is_stream b (fromIntegral w) (fromIntegral bytes))
+	    (read_off_ba fd is_stream b (fromIntegral w) (fromIntegral bytes))
 	    (threadWaitRead fd)
   let res' = fromIntegral res
 #ifdef DEBUG_DUMP
@@ -464,8 +467,11 @@ fillReadBufferLoop fd is_line is_stream buf b w size = do
      	     then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
      	     else return buf{ bufRPtr=0, bufWPtr=w+res' }
  
-foreign import "__hscore_PrelHandle_read" unsafe
-   read_off :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+foreign import ccall unsafe "__hscore_PrelHandle_read"
+   read_off_ba :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+
+foreign import ccall unsafe "__hscore_PrelHandle_read"
+   read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 
 -- ---------------------------------------------------------------------------
 -- Standard Handles
@@ -580,7 +586,7 @@ openFile' filepath ex_mode =
 	       | otherwise	   = False
 
       binary_flags
-	  | binary    = GHC.Handle.o_BINARY
+	  | binary    = o_BINARY
 	  | otherwise = 0
 
       oflags = oflags1 .|. binary_flags
@@ -652,10 +658,10 @@ openFd fd mb_fd_type filepath mode binary truncate = do
 	   mkFileHandle fd is_stream filepath ha_type binary
 
 
-foreign import "lockFile" unsafe
+foreign import ccall unsafe "lockFile"
   lockFile :: CInt -> CInt -> CInt -> IO CInt
 
-foreign import "unlockFile" unsafe
+foreign import ccall unsafe "unlockFile"
   unlockFile :: CInt -> IO CInt
 
 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
@@ -754,17 +760,22 @@ hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return handle_
       _ -> do
-	  let fd = fromIntegral (haFD handle_)
+	  let fd = haFD handle_
+	      c_fd = fromIntegral fd
+
 	  flushWriteBufferOnly handle_
 
-	  -- close the file descriptor, but not when this is the read side
-	  -- of a duplex handle.
+	  -- close the file descriptor, but not when this is the read
+	  -- side of a duplex handle, and not when this is one of the
+	  -- std file handles.
 	  case haOtherSide handle_ of
-	    Nothing -> throwErrnoIfMinus1Retry_ "hClose" 
+	    Nothing -> 
+		when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
+			throwErrnoIfMinus1Retry_ "hClose" 
 #ifdef mingw32_TARGET_OS
-	    					(closeFd (haIsStream handle_) fd)
+	    			(closeFd (haIsStream handle_) c_fd)
 #else
-	    					(c_close fd)
+	    			(c_close c_fd)
 #endif
 	    Just _  -> return ()
 
@@ -772,7 +783,7 @@ hClose_help handle_ =
 	  writeIORef (haBuffers handle_) BufferListNil
 
 	  -- unlock it
-	  unlockFile fd
+	  unlockFile c_fd
 
 	  -- we must set the fd to -1, because the finalizer is going
 	  -- to run eventually and try to close/unlock it.
@@ -1168,49 +1179,25 @@ hSetBinaryMode handle bin =
           (setmode (fromIntegral (haFD handle_)) bin)
        return handle_{haIsBin=bin}
   
-foreign import "__hscore_setmode" unsafe
+foreign import ccall unsafe "__hscore_setmode"
   setmode :: CInt -> Bool -> IO CInt
 
--- -----------------------------------------------------------------------------
--- Miscellaneous
-
--- These three functions are meant to get things out of an IOError.
-
-ioeGetFileName        :: IOError -> Maybe FilePath
-ioeGetErrorString     :: IOError -> String
-ioeGetHandle          :: IOError -> Maybe Handle
-
-ioeGetHandle (IOException (IOError h _ _ _ _)) = h
-ioeGetHandle (UserError _) = Nothing
-ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
-
-ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
-ioeGetErrorString (UserError str) = str
-ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
-
-ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
-ioeGetFileName (UserError _) = Nothing
-ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
-
 -- ---------------------------------------------------------------------------
 -- debugging
 
 #ifdef DEBUG_DUMP
 puts :: String -> IO ()
-puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))
+puts s = withCString s $ \cstr -> do write_off_ba 1 False cstr 0 (fromIntegral (length s))
 				     return ()
 #endif
 
 -- -----------------------------------------------------------------------------
 -- wrappers to platform-specific constants:
 
-foreign import ccall "__hscore_supportsTextMode" unsafe 
+foreign import ccall unsafe "__hscore_supportsTextMode"
   tEXT_MODE_SEEK_ALLOWED :: Bool
 
-foreign import ccall "__hscore_bufsiz"   unsafe dEFAULT_BUFFER_SIZE :: Int
-foreign import ccall "__hscore_seek_cur" unsafe sEEK_CUR :: CInt
-foreign import ccall "__hscore_seek_set" unsafe sEEK_SET :: CInt
-foreign import ccall "__hscore_seek_end" unsafe sEEK_END :: CInt
-foreign import ccall "__hscore_o_binary" unsafe o_BINARY :: CInt
-
-
+foreign import ccall unsafe "__hscore_bufsiz"   dEFAULT_BUFFER_SIZE :: Int
+foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
+foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
+foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt
diff --git a/GHC/IO.hs b/GHC/IO.hs
index 9a488b5..110ae68 100644
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -3,7 +3,7 @@
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: IO.hs,v 1.2 2002/01/02 14:40:10 simonmar Exp $
+-- $Id: IO.hs,v 1.3 2002/02/05 17:32:26 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
@@ -18,6 +18,7 @@ module GHC.IO (
 import Foreign
 import Foreign.C
 
+import System.IO.Error
 import Data.Maybe
 import Control.Monad
 
@@ -58,7 +59,7 @@ hWaitForInput h msecs = do
 	  (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
   return (r /= 0)
 
-foreign import "inputReady" unsafe
+foreign import ccall unsafe "inputReady"
   inputReady :: CInt -> CInt -> Bool -> IO CInt
 
 -- ---------------------------------------------------------------------------
@@ -91,7 +92,7 @@ hGetChar handle =
 	-- make use of the minimal buffer we already have
 	let raw = bufBuf buf
 	r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
-	        (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
+	        (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
 	        (threadWaitRead fd)
 	if r == 0
 	   then ioe_EOF
@@ -271,7 +272,7 @@ lazyRead' h handle_ = do
 	-- make use of the minimal buffer we already have
 	let raw = bufBuf buf
 	r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
-	        (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
+	        (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
 	        (threadWaitRead fd)
 	if r == 0
 	   then do handle_ <- hClose_help handle_ 
@@ -330,7 +331,7 @@ hPutChar handle c =
 	NoBuffering      ->
 		withObject (castCharToCChar c) $ \buf ->
 		throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
-		   (c_write (fromIntegral fd) buf 1)
+		   (write_off (fromIntegral fd) (haIsStream handle_) buf 0 1)
 		   (threadWaitWrite fd)
 
 
@@ -689,13 +690,13 @@ slurpFile fname = do
 -- ---------------------------------------------------------------------------
 -- memcpy wrappers
 
-foreign import "__hscore_memcpy_src_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_src_off"
    memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_src_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_src_off"
    memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_dst_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_dst_off"
    memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_dst_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_dst_off"
    memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
 
 -----------------------------------------------------------------------------
diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 7d94236..e7f5bd0 100644
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: IOBase.lhs,v 1.5 2001/12/21 15:07:25 simonmar Exp $
+% $Id: IOBase.lhs,v 1.6 2002/02/05 17:32:26 simonmar Exp $
 % 
 % (c) The University of Glasgow, 1994-2001
 %
@@ -387,8 +387,8 @@ data Exception
   | DynException	Dynamic		-- Dynamic exceptions
   | AsyncException	AsyncException	-- Externally generated errors
   | BlockedOnDeadMVar			-- Blocking on a dead MVar
+  | Deadlock				-- no threads can run (raised in main thread)
   | NonTermination
-  | UserError		String
 
 data ArithException
   = Overflow
@@ -451,7 +451,25 @@ instance Show Exception where
   showsPrec _ (AsyncException e)	 = shows e
   showsPrec _ (BlockedOnDeadMVar)	 = showString "thread blocked indefinitely"
   showsPrec _ (NonTermination)           = showString "<<loop>>"
-  showsPrec _ (UserError err)            = showString err
+  showsPrec _ (Deadlock)                 = showString "<<deadlock>>"
+
+instance Eq Exception where
+  IOException e1      == IOException e2      = e1 == e2
+  ArithException e1   == ArithException e2   = e1 == e2
+  ArrayException e1   == ArrayException e2   = e1 == e2
+  ErrorCall e1        == ErrorCall e2	     = e1 == e2
+  ExitException	e1    == ExitException e2    = e1 == e2
+  NoMethodError e1    == NoMethodError e2    = e1 == e2
+  PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
+  RecSelError e1      == RecSelError e2      = e1 == e2
+  RecConError e1      == RecConError e2      = e1 == e2
+  RecUpdError e1      == RecUpdError e2      = e1 == e2
+  AssertionFailed e1  == AssertionFailed e2  = e1 == e2
+  DynException _      == DynException _      = False -- incomparable
+  AsyncException e1   == AsyncException e2   = e1 == e2
+  BlockedOnDeadMVar   == BlockedOnDeadMVar   = True
+  NonTermination      == NonTermination      = True
+  Deadlock            == Deadlock            = True
 
 -- -----------------------------------------------------------------------------
 -- The ExitCode type
@@ -492,13 +510,14 @@ ioException err =  IO $ \s -> throw (IOException err) s
 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.
-     (Maybe FilePath) -- filename the error is related to.
+ = IOError {
+     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging 
+				     -- the error.
+     ioe_type     :: IOErrorType,    -- what it was.
+     ioe_location :: String,	     -- location.
+     ioe_descr    :: String,         -- error type specific information.
+     ioe_filename :: Maybe FilePath  -- filename the error is related to.
+   }
 
 instance Eq IOException where
   (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) = 
@@ -507,12 +526,13 @@ instance Eq IOException where
 data IOErrorType
   -- Haskell 98:
   = AlreadyExists
-  | EOF
-  | IllegalOperation
   | NoSuchThing
-  | PermissionDenied
   | ResourceBusy
   | ResourceExhausted
+  | EOF
+  | IllegalOperation
+  | PermissionDenied
+  | UserError
   -- GHC only:
   | UnsatisfiedConstraints
   | SystemError
@@ -538,62 +558,28 @@ instance Show IOErrorType where
     showString $
     case e of
       AlreadyExists	-> "already exists"
-      HardwareFault	-> "hardware fault"
+      NoSuchThing       -> "does not exist"
+      ResourceBusy      -> "resource busy"
+      ResourceExhausted -> "resource exhausted"
+      EOF		-> "end of file"
       IllegalOperation	-> "illegal operation"
+      PermissionDenied  -> "permission denied"
+      UserError		-> "user error"
+      HardwareFault	-> "hardware fault"
       InappropriateType -> "inappropriate type"
       Interrupted       -> "interrupted"
       InvalidArgument   -> "invalid argument"
-      NoSuchThing       -> "does not exist"
       OtherError        -> "failed"
-      PermissionDenied  -> "permission denied"
       ProtocolError     -> "protocol error"
-      ResourceBusy      -> "resource busy"
-      ResourceExhausted -> "resource exhausted"
       ResourceVanished  -> "resource vanished"
       SystemError	-> "system error"
       TimeExpired       -> "timeout"
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
       UnsupportedOperation -> "unsupported operation"
-      EOF		-> "end of file"
       DynIOError{}      -> "unknown IO error"
 
 userError       :: String  -> IOError
-userError str	=  UserError str
-
--- ---------------------------------------------------------------------------
--- Predicates on IOError
-
-isAlreadyExistsError :: IOError -> Bool
-isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
-isAlreadyExistsError _                                             = False
-
-isAlreadyInUseError :: IOError -> Bool
-isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
-isAlreadyInUseError _                                            = False
-
-isFullError :: IOError -> Bool
-isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
-isFullError _                                                 = False
-
-isEOFError :: IOError -> Bool
-isEOFError (IOException (IOError _ EOF _ _ _)) = True
-isEOFError _                                   = False
-
-isIllegalOperation :: IOError -> Bool
-isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
-isIllegalOperation _                                                = False
-
-isPermissionError :: IOError -> Bool
-isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
-isPermissionError _                                                = False
-
-isDoesNotExistError :: IOError -> Bool
-isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
-isDoesNotExistError _                                           = False
-
-isUserError :: IOError -> Bool
-isUserError (UserError _) = True
-isUserError _             = False
+userError str	=  IOException (IOError Nothing UserError "" str Nothing)
 
 -- ---------------------------------------------------------------------------
 -- Showing IOErrors
diff --git a/GHC/List.lhs b/GHC/List.lhs
index b7f4beb..4aa2fd1 100644
--- a/GHC/List.lhs
+++ b/GHC/List.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: List.lhs,v 1.5 2001/12/21 15:07:25 simonmar Exp $
+% $Id: List.lhs,v 1.6 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -118,18 +118,20 @@ length l                =  len l 0#
 -- filter, applied to a predicate and a list, returns the list of those
 -- elements that satisfy the predicate; i.e.,
 -- filter p xs = [ x | x <- xs, p x]
-{-# NOINLINE [1] filter #-}
 filter :: (a -> Bool) -> [a] -> [a]
-filter = filterList
+filter _pred []    = []
+filter pred (x:xs)
+  | pred x         = x : filter pred xs
+  | otherwise	   = filter pred xs
 
-{-# INLINE [0] filter #-}
+{-# NOINLINE [0] filterFB #-}
 filterFB c p x r | p x       = x `c` r
 		 | otherwise = r
 
 {-# RULES
-"filter"	forall p xs.	filter p xs = build (\c n -> foldr (filterFB c p) n xs)
-"filterFB"	forall c p q.	filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
-"filterList" 	forall p.	foldr (filterFB (:) p) [] = filterList p
+"filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+"filterList" [1]  forall p.	foldr (filterFB (:) p) [] = filter p
+"filterFB"	  forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
  #-}
 
 -- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
@@ -141,11 +143,6 @@ filterFB c p x r | p x       = x `c` r
 -- I originally wrote (\x -> p x && q x), which is wrong, and actually
 -- gave rise to a live bug report.  SLPJ.
 
-filterList :: (a -> Bool) -> [a] -> [a]
-filterList _pred []    = []
-filterList pred (x:xs)
-  | pred x         = x : filterList pred xs
-  | otherwise	   = filterList pred xs
 
 -- foldl, applied to a binary operator, a starting value (typically the
 -- left-identity of the operator), and a list, reduces the list using
@@ -204,32 +201,30 @@ scanr1 f (x:xs)		=  f x q : qs
 -- iterate f x returns an infinite list of repeated applications of f to x:
 -- iterate f x == [x, f x, f (f x), ...]
 iterate :: (a -> a) -> a -> [a]
-{-# NOINLINE [1] iterate #-}
-iterate = iterateList
+iterate f x =  x : iterate f (f x)
 
 iterateFB c f x = x `c` iterateFB c f (f x)
 
-iterateList f x =  x : iterateList f (f x)
 
 {-# RULES
-"iterate"	forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
-"iterateFB" 			iterateFB (:) = iterateList
+"iterate"    [~1] forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB"  [1]		iterateFB (:) = iterate
  #-}
 
 
 -- repeat x is an infinite list, with x the value of every element.
 repeat :: a -> [a]
-{-# NOINLINE [1] repeat #-}
-repeat = repeatList
+{-# INLINE [0] repeat #-}
+-- The pragma just gives the rules more chance to fire
+repeat x = xs where xs = x : xs
 
-{-# INLINE [0] repeatFB #-}
+{-# INLINE [0] repeatFB #-}	-- ditto
 repeatFB c x = xs where xs = x `c` xs
 
-repeatList x = xs where xs = x :   xs
 
 {-# RULES
-"repeat"	forall x. repeat x	= build (\c _n -> repeatFB c x)
-"repeatFB" 		  repeatFB (:)	= repeatList
+"repeat"    [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
+"repeatFB"  [1]  repeatFB (:)	    = repeat
  #-}
 
 -- replicate n x is a list of length n with x the value of every element
@@ -445,7 +440,9 @@ concat = foldr (++) []
 
 {-# RULES
   "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+-- We don't bother to turn non-fusible applications of concat back into concat
  #-}
+
 \end{code}
 
 
@@ -520,20 +517,15 @@ tuples are in the List module.
 \begin{code}
 ----------------------------------------------
 zip :: [a] -> [b] -> [(a,b)]
-{-# NOINLINE [1] zip #-}
-zip = zipList
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _      _      = []
 
 {-# INLINE [0] zipFB #-}
 zipFB c x y r = (x,y) `c` r
 
-
-zipList               :: [a] -> [b] -> [(a,b)]
-zipList (a:as) (b:bs) = (a,b) : zipList as bs
-zipList _      _      = []
-
 {-# RULES
-"zip"		forall xs ys. zip xs ys	= build (\c n -> foldr2 (zipFB c) n xs ys)
-"zipList"	foldr2 (zipFB (:)) []   = zipList
+"zip"	   [~1]	forall xs ys. zip xs ys	= build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList"  [1]	foldr2 (zipFB (:)) []   = zip
  #-}
 \end{code}
 
@@ -556,19 +548,15 @@ zip3 _      _      _      = []
 \begin{code}
 ----------------------------------------------
 zipWith :: (a->b->c) -> [a]->[b]->[c]
-{-# NOINLINE [1] zipWith #-}
-zipWith = zipWithList
+zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
+zipWith _ _      _      = []
 
 {-# INLINE [0] zipWithFB #-}
 zipWithFB c f x y r = (x `f` y) `c` r
 
-zipWithList                 :: (a->b->c) -> [a] -> [b] -> [c]
-zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs
-zipWithList _ _      _      = []
-
 {-# RULES
-"zipWith"	forall f xs ys.	zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
-"zipWithList"	forall f. 	foldr2 (zipWithFB (:) f) [] = zipWithList f
+"zipWith"	[~1] forall f xs ys.	zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
+"zipWithList"	[1]  forall f. 	foldr2 (zipWithFB (:) f) [] = zipWith f
   #-}
 \end{code}
 
diff --git a/GHC/Num.lhs b/GHC/Num.lhs
index 8bc005b..52c2a7b 100644
--- a/GHC/Num.lhs
+++ b/GHC/Num.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Num.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
+% $Id: Num.lhs,v 1.4 2002/02/05 17:32:26 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -382,33 +382,29 @@ instance  Enum Integer  where
     {-# INLINE enumFromThen #-}
     {-# INLINE enumFromTo #-}
     {-# INLINE enumFromThenTo #-}
-    enumFrom x             = efdInteger  x 1
-    enumFromThen x y       = efdInteger  x (y-x)
-    enumFromTo x lim	   = efdtInteger x 1     lim
-    enumFromThenTo x y lim = efdtInteger x (y-x) lim
-
-
-efdInteger  = enumDeltaIntegerList
-efdtInteger = enumDeltaToIntegerList
+    enumFrom x             = enumDeltaInteger  x 1
+    enumFromThen x y       = enumDeltaInteger  x (y-x)
+    enumFromTo x lim	   = enumDeltaToInteger x 1     lim
+    enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
 
 {-# RULES
-"efdInteger"		forall x y.  efdInteger x y	    = build (\c _ -> enumDeltaIntegerFB c x y)
-"efdtInteger"		forall x y l.efdtInteger x y l	    = build (\c n -> enumDeltaToIntegerFB c n x y l)
-"enumDeltaInteger" 	enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
-"enumDeltaToInteger" 	enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
+"enumDeltaInteger"	[~1] forall x y.  enumDeltaInteger x y     = build (\c _ -> enumDeltaIntegerFB c x y)
+"efdtInteger"		[~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l)
+"enumDeltaInteger" 	[1] enumDeltaIntegerFB   (:)    = enumDeltaInteger
+"enumDeltaToInteger" 	[1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
  #-}
 
 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
 
-enumDeltaIntegerList :: Integer -> Integer -> [Integer]
-enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
+enumDeltaInteger :: Integer -> Integer -> [Integer]
+enumDeltaInteger x d = x : enumDeltaInteger (x+d) d
 
 enumDeltaToIntegerFB c n x delta lim
   | delta >= 0 = up_fb c n x delta lim
   | otherwise  = dn_fb c n x delta lim
 
-enumDeltaToIntegerList x delta lim
+enumDeltaToInteger x delta lim
   | delta >= 0 = up_list x delta lim
   | otherwise  = dn_list x delta lim
 
diff --git a/GHC/Posix.hsc b/GHC/Posix.hs
similarity index 50%
rename from GHC/Posix.hsc
rename to GHC/Posix.hs
index dc714f2..ab76862 100644
--- a/GHC/Posix.hsc
+++ b/GHC/Posix.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-implicit-prelude #-}
 
 -- ---------------------------------------------------------------------------
--- $Id: Posix.hsc,v 1.6 2002/01/02 15:01:44 simonmar Exp $
+-- $Id: Posix.hs,v 1.1 2002/02/05 17:32:26 simonmar Exp $
 --
 -- POSIX support layer for the standard libraries
 --
@@ -10,10 +10,7 @@
 
 module GHC.Posix where
 
--- See above comment for non-Posixness reasons.
--- #include "PosixSource.h"
-
-#include "HsCore.h"
+#include "config.h"
 
 import Control.Monad
 
@@ -46,22 +43,22 @@ type CTms	= ()
 type CUtimbuf   = ()
 type CUtsname   = ()
 
-type CDev    = #type dev_t
-type CIno    = #type ino_t
-type CMode   = #type mode_t
-type COff    = #type off_t
-type CPid    = #type pid_t
+type CDev    = HTYPE_DEV_T
+type CIno    = HTYPE_INO_T
+type CMode   = HTYPE_MODE_T
+type COff    = HTYPE_OFF_T
+type CPid    = HTYPE_PID_T
 
 #ifdef mingw32_TARGET_OS
-type CSsize  = #type size_t
+type CSsize  = HTYPE_SIZE_T
 #else
-type CGid    = #type gid_t
-type CNlink  = #type nlink_t
-type CSsize  = #type ssize_t
-type CUid    = #type uid_t
-type CCc     = #type cc_t
-type CSpeed  = #type speed_t
-type CTcflag = #type tcflag_t
+type CGid    = HTYPE_GID_T
+type CNlink  = HTYPE_NLINK_T
+type CSsize  = HTYPE_SSIZE_T
+type CUid    = HTYPE_UID_T
+type CCc     = HTYPE_CC_T
+type CSpeed  = HTYPE_SPEED_T
+type CTcflag = HTYPE_TCFLAG_T
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -69,14 +66,14 @@ type CTcflag = #type tcflag_t
 
 fdFileSize :: Int -> IO Integer
 fdFileSize fd = 
-  allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
-    throwErrnoIfMinus1Retry "fdFileSize" $
+  allocaBytes sizeof_stat $ \ p_stat -> do
+    throwErrnoIfMinus1Retry "fileSize" $
 	c_fstat (fromIntegral fd) p_stat
-    c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode 
+    c_mode <- st_mode p_stat :: IO CMode 
     if not (s_isreg c_mode)
 	then return (-1)
 	else do
-    c_size <- (#peek struct stat, st_size) p_stat :: IO COff
+    c_size <- st_size p_stat :: IO COff
     return (fromIntegral c_size)
 
 data FDType  = Directory | Stream | RegularFile
@@ -84,7 +81,7 @@ data FDType  = Directory | Stream | RegularFile
 
 fileType :: FilePath -> IO FDType
 fileType file =
-  allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
+  allocaBytes sizeof_stat $ \ p_stat -> do
   withCString file $ \p_file -> do
     throwErrnoIfMinus1Retry "fileType" $
       c_stat p_file p_stat
@@ -94,13 +91,13 @@ fileType file =
 -- referring to file handles. i.e., it'll fail for socket FDs.
 fdType :: Int -> IO FDType
 fdType fd = 
-  allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
+  allocaBytes sizeof_stat $ \ p_stat -> do
     throwErrnoIfMinus1Retry "fdType" $
 	c_fstat (fromIntegral fd) p_stat
     statGetType p_stat
 
 statGetType p_stat = do
-  c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode
+  c_mode <- st_mode p_stat :: IO CMode
   case () of
       _ | s_isdir c_mode 	 	     -> return Directory
         | s_isfifo c_mode || s_issock c_mode -> return Stream
@@ -129,7 +126,7 @@ closeFd isStream fd
   | isStream  = c_closesocket fd
   | otherwise = c_close fd
 
-foreign import "closesocket" unsafe
+foreign import ccall unsafe "closesocket"
    c_closesocket :: CInt -> IO CInt
 #endif
 
@@ -143,44 +140,45 @@ fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
 
 setEcho :: Int -> Bool -> IO ()
 setEcho fd on = do
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setEcho"
 	(c_tcgetattr (fromIntegral fd) p_tios)
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    let new_c_lflag | on        = c_lflag .|. (#const ECHO)
-	            | otherwise = c_lflag .&. complement (#const ECHO)
-    (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
-    tcSetAttr fd (#const TCSANOW) p_tios
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    let new_c_lflag
+	 | on        = c_lflag .|. fromIntegral const_echo
+	 | otherwise = c_lflag .&. complement (fromIntegral const_echo)
+    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
+    tcSetAttr fd const_tcsanow p_tios
 
 getEcho :: Int -> IO Bool
 getEcho fd = do
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setEcho"
 	(c_tcgetattr (fromIntegral fd) p_tios)
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    return ((c_lflag .&. (#const ECHO)) /= 0)
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    return ((c_lflag .&. fromIntegral const_echo) /= 0)
 
 setCooked :: Int -> Bool -> IO ()
 setCooked fd cooked = 
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setCooked"
 	(c_tcgetattr (fromIntegral fd) p_tios)
 
     -- turn on/off ICANON
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    let new_c_lflag | cooked    = c_lflag .|. (#const ICANON)
-	            | otherwise = c_lflag .&. complement (#const ICANON)
-    (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    let new_c_lflag | cooked    = c_lflag .|. (fromIntegral const_icanon)
+	            | otherwise = c_lflag .&. complement (fromIntegral const_icanon)
+    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
 
     -- set VMIN & VTIME to 1/0 respectively
     when cooked $ do
-	    let c_cc  = (#ptr struct termios, c_cc) p_tios
-		vmin  = c_cc `plusPtr` (#const VMIN)  :: Ptr Word8
-		vtime = c_cc `plusPtr` (#const VTIME) :: Ptr Word8
+            c_cc <- ptr_c_cc p_tios
+	    let vmin  = (c_cc `plusPtr` (fromIntegral const_vmin))  :: Ptr Word8
+		vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8
 	    poke vmin  1
 	    poke vtime 0
 
-    tcSetAttr fd (#const TCSANOW) p_tios
+    tcSetAttr fd const_tcsanow p_tios
 
 -- tcsetattr() when invoked by a background process causes the process
 -- to be sent SIGTTOU regardless of whether the process has TOSTOP set
@@ -190,14 +188,14 @@ setCooked fd cooked =
 
 tcSetAttr :: FD -> CInt -> Ptr CTermios -> IO ()
 tcSetAttr fd options p_tios = do
-  allocaBytes (#const sizeof(sigset_t)) $ \ p_sigset -> do
-  allocaBytes (#const sizeof(sigset_t)) $ \ p_old_sigset -> do
+  allocaBytes sizeof_sigset_t $ \ p_sigset -> do
+  allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
      c_sigemptyset p_sigset
-     c_sigaddset   p_sigset (#const SIGTTOU)
-     c_sigprocmask (#const SIG_BLOCK) p_sigset p_old_sigset
+     c_sigaddset   p_sigset const_sigttou
+     c_sigprocmask const_sig_block p_sigset p_old_sigset
      throwErrnoIfMinus1Retry_ "tcSetAttr" $
 	 c_tcsetattr (fromIntegral fd) options p_tios
-     c_sigprocmask (#const SIG_SETMASK) p_old_sigset nullPtr
+     c_sigprocmask const_sig_setmask p_old_sigset nullPtr
 
 #else
 
@@ -220,12 +218,11 @@ getEcho fd = return False
 
 setNonBlockingFD fd = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
-		 (c_fcntl_read (fromIntegral fd) (#const F_GETFL))
+		 (c_fcntl_read (fromIntegral fd) const_f_getfl)
   -- An error when setting O_NONBLOCK isn't fatal: on some systems 
   -- there are certain file handles on which this will fail (eg. /dev/null
   -- on FreeBSD) so we throw away the return code from fcntl_write.
-  c_fcntl_write (fromIntegral fd) 
-	(#const F_SETFL) (flags .|. #const O_NONBLOCK)
+  c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK)
 #else
 
 -- bogus defns for win32
@@ -236,172 +233,184 @@ setNonBlockingFD fd = return ()
 -- -----------------------------------------------------------------------------
 -- foreign imports
 
--- POSIX flags only:
-o_RDONLY    = (#const O_RDONLY)	   :: CInt
-o_WRONLY    = (#const O_WRONLY)	   :: CInt
-o_RDWR      = (#const O_RDWR)	   :: CInt
-o_APPEND    = (#const O_APPEND)	   :: CInt
-o_CREAT     = (#const O_CREAT)	   :: CInt
-o_EXCL	    = (#const O_EXCL)	   :: CInt
-o_TRUNC     = (#const O_TRUNC)	   :: CInt
-
-#ifdef mingw32_TARGET_OS
-o_NOCTTY    = 0 :: CInt
-o_NONBLOCK  = 0 :: CInt
-#else
-o_NOCTTY    = (#const O_NOCTTY)	   :: CInt
-o_NONBLOCK  = (#const O_NONBLOCK)  :: CInt
-#endif
-
-#ifdef HAVE_O_BINARY
-o_BINARY    = (#const O_BINARY)	   :: CInt
-#endif
-
-foreign import ccall "access" unsafe
+foreign import ccall unsafe "access"
    c_access :: CString -> CMode -> IO CInt
 
-foreign import ccall "chmod" unsafe
+foreign import ccall unsafe "chmod"
    c_chmod :: CString -> CMode -> IO CInt
 
-foreign import ccall "chdir" unsafe
+foreign import ccall unsafe "chdir"
    c_chdir :: CString -> IO CInt
 
-foreign import ccall "chown" unsafe
+foreign import ccall unsafe "chown"
    c_chown :: CString -> CUid -> CGid -> IO CInt
 
-foreign import ccall "close" unsafe
+foreign import ccall unsafe "close"
    c_close :: CInt -> IO CInt
 
-foreign import ccall "closedir" unsafe 
+foreign import ccall unsafe "closedir" 
    c_closedir :: Ptr CDir -> IO CInt
 
-foreign import ccall "creat" unsafe
+foreign import ccall unsafe "creat"
    c_creat :: CString -> CMode -> IO CInt
 
-foreign import ccall "dup" unsafe
+foreign import ccall unsafe "dup"
    c_dup :: CInt -> IO CInt
 
-foreign import ccall "dup2" unsafe
+foreign import ccall unsafe "dup2"
    c_dup2 :: CInt -> CInt -> IO CInt
 
-foreign import ccall "fpathconf" unsafe
+foreign import ccall unsafe "fpathconf"
    c_fpathconf :: CInt -> CInt -> IO CLong
 
-foreign import ccall "fstat" unsafe
+foreign import ccall unsafe "fstat"
    c_fstat :: CInt -> Ptr CStat -> IO CInt
 
-foreign import ccall "getcwd" unsafe
+foreign import ccall unsafe "getcwd"
    c_getcwd   :: Ptr CChar -> CInt -> IO (Ptr CChar)
 
-foreign import ccall "isatty" unsafe
+foreign import ccall unsafe "isatty"
    c_isatty :: CInt -> IO CInt
 
-foreign import ccall "link" unsafe
+foreign import ccall unsafe "link"
    c_link :: CString -> CString -> IO CInt
 
-foreign import ccall "lseek" unsafe
+foreign import ccall unsafe "lseek"
    c_lseek :: CInt -> COff -> CInt -> IO COff
 
-#ifdef HAVE_LSTAT
-foreign import ccall "lstat" unsafe
-   c_lstat :: CString -> Ptr CStat -> IO CInt
-#endif
+foreign import ccall unsafe "__hscore_lstat"
+   lstat :: CString -> Ptr CStat -> IO CInt
 
-foreign import ccall "open" unsafe
+foreign import ccall unsafe "open"
    c_open :: CString -> CInt -> CMode -> IO CInt
 
-foreign import ccall "opendir" unsafe 
+foreign import ccall unsafe "opendir" 
    c_opendir :: CString  -> IO (Ptr CDir)
 
-foreign import ccall "mkdir" unsafe
-#if defined(mingw32_TARGET_OS)
-   c_mkdir :: CString -> IO CInt
-#else
-   c_mkdir :: CString -> CMode -> IO CInt
-#endif
+foreign import ccall unsafe "__hscore_mkdir"
+   mkdir :: CString -> CInt -> IO CInt
 
-foreign import ccall "mkfifo" unsafe
+foreign import ccall unsafe "mkfifo"
    c_mkfifo :: CString -> CMode -> IO CInt
 
-foreign import ccall "pathconf" unsafe
+foreign import ccall unsafe "pathconf"
    c_pathconf :: CString -> CInt -> IO CLong
 
-foreign import ccall "pipe" unsafe
+foreign import ccall unsafe "pipe"
    c_pipe :: Ptr CInt -> IO CInt
 
-foreign import ccall "read" unsafe 
+foreign import ccall unsafe "read" 
    c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
 
-foreign import ccall "readdir" unsafe 
+foreign import ccall unsafe "readdir" 
    c_readdir :: Ptr CDir -> IO (Ptr CDirent)
 
-foreign import ccall "rename" unsafe
+foreign import ccall unsafe "rename"
    c_rename :: CString -> CString -> IO CInt
 		     
-foreign import ccall "rewinddir" unsafe
+foreign import ccall unsafe "rewinddir"
    c_rewinddir :: Ptr CDir -> IO ()
 
-foreign import ccall "rmdir" unsafe
+foreign import ccall unsafe "rmdir"
    c_rmdir :: CString -> IO CInt
 
-foreign import ccall "stat" unsafe
+foreign import ccall unsafe "stat"
    c_stat :: CString -> Ptr CStat -> IO CInt
 
-foreign import ccall "umask" unsafe
+foreign import ccall unsafe "umask"
    c_umask :: CMode -> IO CMode
 
-foreign import ccall "utime" unsafe
+foreign import ccall unsafe "utime"
    c_utime :: CString -> Ptr CUtimbuf -> IO CMode
 
-foreign import ccall "write" unsafe 
+foreign import ccall unsafe "write" 
    c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
 
 #ifndef mingw32_TARGET_OS
-foreign import ccall "fcntl" unsafe
+foreign import ccall unsafe "fcntl"
    c_fcntl_read  :: CInt -> CInt -> IO CInt
 
-foreign import ccall "fcntl" unsafe
+foreign import ccall unsafe "fcntl"
    c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt
 
-foreign import ccall "fcntl" unsafe
+foreign import ccall unsafe "fcntl"
    c_fcntl_lock  :: CInt -> CInt -> Ptr CFLock -> IO CInt
 
-foreign import ccall "fork" unsafe
+foreign import ccall unsafe "fork"
    c_fork :: IO CPid 
 
-foreign import ccall "__hscore_sigemptyset" unsafe
+foreign import ccall unsafe "__hscore_sigemptyset"
    c_sigemptyset :: Ptr CSigset -> IO ()
 
-foreign import ccall "sigaddset" unsafe
+foreign import ccall unsafe "sigaddset"
    c_sigaddset :: Ptr CSigset -> CInt -> IO ()
 
-foreign import ccall "sigprocmask" unsafe
+foreign import ccall unsafe "sigprocmask"
    c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO ()
 
-foreign import ccall "tcgetattr" unsafe
+foreign import ccall unsafe "tcgetattr"
    c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
 
-foreign import ccall "tcsetattr" unsafe
+foreign import ccall unsafe "tcsetattr"
    c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
 
-foreign import ccall "uname" unsafe
+foreign import ccall unsafe "uname"
    c_uname :: Ptr CUtsname -> IO CInt
 
-foreign import ccall "unlink" unsafe
+foreign import ccall unsafe "unlink"
    c_unlink :: CString -> IO CInt
 
-foreign import ccall "waitpid" unsafe
+foreign import ccall unsafe "waitpid"
    c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
 #endif
 
-foreign import "__hscore_s_isreg"  unsafe s_isreg  :: CMode -> Bool
-foreign import "__hscore_s_ischr"  unsafe s_ischr  :: CMode -> Bool
-foreign import "__hscore_s_isblk"  unsafe s_isblk  :: CMode -> Bool
-foreign import "__hscore_s_isdir"  unsafe s_isdir  :: CMode -> Bool
-foreign import "__hscore_s_isfifo" unsafe s_isfifo :: CMode -> Bool
+-- POSIX flags only:
+foreign import ccall unsafe "__hscore_o_rdonly" o_RDONLY :: CInt
+foreign import ccall unsafe "__hscore_o_wronly" o_WRONLY :: CInt
+foreign import ccall unsafe "__hscore_o_rdwr"   o_RDWR   :: CInt
+foreign import ccall unsafe "__hscore_o_append" o_APPEND :: CInt
+foreign import ccall unsafe "__hscore_o_creat"  o_CREAT  :: CInt
+foreign import ccall unsafe "__hscore_o_excl"   o_EXCL   :: CInt
+foreign import ccall unsafe "__hscore_o_trunc"  o_TRUNC  :: CInt
+
+-- non-POSIX flags.
+foreign import ccall unsafe "__hscore_o_noctty"   o_NOCTTY   :: CInt
+foreign import ccall unsafe "__hscore_o_nonblock" o_NONBLOCK :: CInt
+foreign import ccall unsafe "__hscore_o_binary"   o_BINARY   :: CInt
+
+foreign import ccall unsafe "__hscore_s_isreg"  s_isreg  :: CMode -> Bool
+foreign import ccall unsafe "__hscore_s_ischr"  s_ischr  :: CMode -> Bool
+foreign import ccall unsafe "__hscore_s_isblk"  s_isblk  :: CMode -> Bool
+foreign import ccall unsafe "__hscore_s_isdir"  s_isdir  :: CMode -> Bool
+foreign import ccall unsafe "__hscore_s_isfifo" s_isfifo :: CMode -> Bool
+
+foreign import ccall unsafe "__hscore_sizeof_stat" sizeof_stat :: Int
+foreign import ccall unsafe "__hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime
+foreign import ccall unsafe "__hscore_st_size" st_size :: Ptr CStat -> IO COff
+foreign import ccall unsafe "__hscore_st_mode" st_mode :: Ptr CStat -> IO CMode
+
+foreign import ccall unsafe "__hscore_lflag" c_lflag :: Ptr CTermios -> IO CTcflag
+foreign import ccall unsafe "__hscore_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO ()
+foreign import ccall unsafe "__hscore_ptr_c_cc" ptr_c_cc  :: Ptr CTermios -> IO (Ptr Word8)
+
+foreign import ccall unsafe "__hscore_echo"         const_echo :: CInt
+foreign import ccall unsafe "__hscore_tcsanow"      const_tcsanow :: CInt
+foreign import ccall unsafe "__hscore_icanon"       const_icanon :: CInt
+foreign import ccall unsafe "__hscore_vmin"         const_vmin   :: CInt
+foreign import ccall unsafe "__hscore_vtime"        const_vtime  :: CInt
+foreign import ccall unsafe "__hscore_sigttou"      const_sigttou :: CInt
+foreign import ccall unsafe "__hscore_sig_block"    const_sig_block :: CInt
+foreign import ccall unsafe "__hscore_sig_setmask"  const_sig_setmask :: CInt
+foreign import ccall unsafe "__hscore_f_getfl"      const_f_getfl :: CInt
+foreign import ccall unsafe "__hscore_f_setfl"      const_f_setfl :: CInt
+
+#ifndef mingw32_TARGET_OS
+foreign import ccall unsafe "__hscore_sizeof_termios"  sizeof_termios :: Int
+foreign import ccall unsafe "__hscore_sizeof_sigset_t" sizeof_sigset_t :: Int
+#endif
 
 #ifndef mingw32_TARGET_OS
-foreign import "__hscore_s_issock" s_issock :: CMode -> Bool
+foreign import ccall unsafe "__hscore_s_issock" s_issock :: CMode -> Bool
 #else
 s_issock :: CMode -> Bool
 s_issock cmode = False
diff --git a/GHC/Storable.lhs b/GHC/Storable.lhs
index afbbb9d..f0c44e4 100644
--- a/GHC/Storable.lhs
+++ b/GHC/Storable.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Storable.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
+% $Id: Storable.lhs,v 1.4 2002/02/05 17:32:27 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -20,8 +20,7 @@ module GHC.Storable
 	     peekByteOff,    -- :: Ptr b -> Int      -> IO a
 	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
 	     peek,           -- :: Ptr a             -> IO a
-	     poke,           -- :: Ptr a        -> a -> IO ()
-	     destruct)       -- :: Ptr a             -> IO ()
+	     poke)           -- :: Ptr a        -> a -> IO ()
         ) where
 \end{code}
 
@@ -68,10 +67,6 @@ class Storable a where
    peek        :: Ptr a      -> IO a
    poke        :: Ptr a -> a -> IO ()
 
-   -- free memory associated with the object
-   -- (except the object pointer itself)
-   destruct    :: Ptr a -> IO ()
-
    -- circular default instances
    peekElemOff = peekElemOff_ undefined
       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
@@ -83,8 +78,6 @@ class Storable a where
 
    peek ptr = peekElemOff ptr 0
    poke ptr = pokeElemOff ptr 0
-
-   destruct _ = return ()
 \end{code}
 
 System-dependent, but rather obvious instances
diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 344a856..d7519ef 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -1,5 +1,5 @@
 -- -----------------------------------------------------------------------------
--- $Id: TopHandler.lhs,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: TopHandler.lhs,v 1.4 2002/02/05 17:32:27 simonmar Exp $
 --
 -- (c) The University of Glasgow, 2001
 --
@@ -43,6 +43,9 @@ real_handler ex =
 	ExitException ExitSuccess     -> shutdownHaskellAndExit 0
 	ExitException (ExitFailure n) -> shutdownHaskellAndExit n
 
+	Deadlock    -> reportError True 
+			"no threads to run:  infinite loop or deadlock?"
+  
 	ErrorCall s -> reportError True s
 	other       -> reportError True (showsPrec 0 other "\n")
 
diff --git a/GHC/Word.lhs b/GHC/Word.lhs
index 06a5c24..bafd410 100644
--- a/GHC/Word.lhs
+++ b/GHC/Word.lhs
@@ -465,29 +465,29 @@ instance Bits Word32 where
     bitSize  _                = 32
     isSigned _                = False
 
-foreign import "stg_eqWord32"      unsafe eqWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_neWord32"      unsafe neWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_ltWord32"      unsafe ltWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_leWord32"      unsafe leWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_gtWord32"      unsafe gtWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_geWord32"      unsafe geWord32#      :: Word32# -> Word32# -> Bool
-foreign import "stg_int32ToWord32" unsafe int32ToWord32# :: Int32# -> Word32#
-foreign import "stg_word32ToInt32" unsafe word32ToInt32# :: Word32# -> Int32#
-foreign import "stg_intToInt32"    unsafe intToInt32#    :: Int# -> Int32#
-foreign import "stg_wordToWord32"  unsafe wordToWord32#  :: Word# -> Word32#
-foreign import "stg_word32ToWord"  unsafe word32ToWord#  :: Word32# -> Word#
-foreign import "stg_plusInt32"     unsafe plusInt32#     :: Int32# -> Int32# -> Int32#
-foreign import "stg_minusInt32"    unsafe minusInt32#    :: Int32# -> Int32# -> Int32#
-foreign import "stg_timesInt32"    unsafe timesInt32#    :: Int32# -> Int32# -> Int32#
-foreign import "stg_negateInt32"   unsafe negateInt32#   :: Int32# -> Int32#
-foreign import "stg_quotWord32"    unsafe quotWord32#    :: Word32# -> Word32# -> Word32#
-foreign import "stg_remWord32"     unsafe remWord32#     :: Word32# -> Word32# -> Word32#
-foreign import "stg_and32"         unsafe and32#         :: Word32# -> Word32# -> Word32#
-foreign import "stg_or32"          unsafe or32#          :: Word32# -> Word32# -> Word32#
-foreign import "stg_xor32"         unsafe xor32#         :: Word32# -> Word32# -> Word32#
-foreign import "stg_not32"         unsafe not32#         :: Word32# -> Word32#
-foreign import "stg_shiftL32"      unsafe shiftL32#      :: Word32# -> Int# -> Word32#
-foreign import "stg_shiftRL32"     unsafe shiftRL32#     :: Word32# -> Int# -> Word32#
+foreign import unsafe "stg_eqWord32"      eqWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_neWord32"      neWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_ltWord32"      ltWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_leWord32"      leWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_gtWord32"      gtWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_geWord32"      geWord32#      :: Word32# -> Word32# -> Bool
+foreign import unsafe "stg_int32ToWord32" int32ToWord32# :: Int32# -> Word32#
+foreign import unsafe "stg_word32ToInt32" word32ToInt32# :: Word32# -> Int32#
+foreign import unsafe "stg_intToInt32"    intToInt32#    :: Int# -> Int32#
+foreign import unsafe "stg_wordToWord32"  wordToWord32#  :: Word# -> Word32#
+foreign import unsafe "stg_word32ToWord"  word32ToWord#  :: Word32# -> Word#
+foreign import unsafe "stg_plusInt32"     plusInt32#     :: Int32# -> Int32# -> Int32#
+foreign import unsafe "stg_minusInt32"    minusInt32#    :: Int32# -> Int32# -> Int32#
+foreign import unsafe "stg_timesInt32"    timesInt32#    :: Int32# -> Int32# -> Int32#
+foreign import unsafe "stg_negateInt32"   negateInt32#   :: Int32# -> Int32#
+foreign import unsafe "stg_quotWord32"    quotWord32#    :: Word32# -> Word32# -> Word32#
+foreign import unsafe "stg_remWord32"     remWord32#     :: Word32# -> Word32# -> Word32#
+foreign import unsafe "stg_and32"         and32#         :: Word32# -> Word32# -> Word32#
+foreign import unsafe "stg_or32"          or32#          :: Word32# -> Word32# -> Word32#
+foreign import unsafe "stg_xor32"         xor32#         :: Word32# -> Word32# -> Word32#
+foreign import unsafe "stg_not32"         not32#         :: Word32# -> Word32#
+foreign import unsafe "stg_shiftL32"      shiftL32#      :: Word32# -> Int# -> Word32#
+foreign import unsafe "stg_shiftRL32"     shiftRL32#     :: Word32# -> Int# -> Word32#
 
 {-# RULES
 "fromIntegral/Int->Word32"    fromIntegral = \(I#   x#) -> W32# (int32ToWord32# (intToInt32# x#))
@@ -723,31 +723,31 @@ instance Bits Word64 where
     bitSize  _                = 64
     isSigned _                = False
 
-foreign import "stg_eqWord64"      unsafe eqWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_neWord64"      unsafe neWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_ltWord64"      unsafe ltWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_leWord64"      unsafe leWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_gtWord64"      unsafe gtWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_geWord64"      unsafe geWord64#      :: Word64# -> Word64# -> Bool
-foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
-foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
-foreign import "stg_intToInt64"    unsafe intToInt64#    :: Int# -> Int64#
-foreign import "stg_wordToWord64"  unsafe wordToWord64#  :: Word# -> Word64#
-foreign import "stg_word64ToWord"  unsafe word64ToWord#  :: Word64# -> Word#
-foreign import "stg_plusInt64"     unsafe plusInt64#     :: Int64# -> Int64# -> Int64#
-foreign import "stg_minusInt64"    unsafe minusInt64#    :: Int64# -> Int64# -> Int64#
-foreign import "stg_timesInt64"    unsafe timesInt64#    :: Int64# -> Int64# -> Int64#
-foreign import "stg_negateInt64"   unsafe negateInt64#   :: Int64# -> Int64#
-foreign import "stg_quotWord64"    unsafe quotWord64#    :: Word64# -> Word64# -> Word64#
-foreign import "stg_remWord64"     unsafe remWord64#     :: Word64# -> Word64# -> Word64#
-foreign import "stg_and64"         unsafe and64#         :: Word64# -> Word64# -> Word64#
-foreign import "stg_or64"          unsafe or64#          :: Word64# -> Word64# -> Word64#
-foreign import "stg_xor64"         unsafe xor64#         :: Word64# -> Word64# -> Word64#
-foreign import "stg_not64"         unsafe not64#         :: Word64# -> Word64#
-foreign import "stg_shiftL64"      unsafe shiftL64#      :: Word64# -> Int# -> Word64#
-foreign import "stg_shiftRL64"     unsafe shiftRL64#     :: Word64# -> Int# -> Word64#
-
-foreign import "stg_integerToWord64" unsafe integerToWord64# :: Int# -> ByteArray# -> Word64#
+foreign import ccall unsafe "stg_eqWord64"      eqWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_neWord64"      neWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_ltWord64"      ltWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_leWord64"      leWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_gtWord64"      gtWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_geWord64"      geWord64#      :: Word64# -> Word64# -> Bool
+foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64#
+foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64#
+foreign import ccall unsafe "stg_intToInt64"    intToInt64#    :: Int# -> Int64#
+foreign import ccall unsafe "stg_wordToWord64"  wordToWord64#  :: Word# -> Word64#
+foreign import ccall unsafe "stg_word64ToWord"  word64ToWord#  :: Word64# -> Word#
+foreign import ccall unsafe "stg_plusInt64"     plusInt64#     :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "stg_minusInt64"    minusInt64#    :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "stg_timesInt64"    timesInt64#    :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "stg_negateInt64"   negateInt64#   :: Int64# -> Int64#
+foreign import ccall unsafe "stg_quotWord64"    quotWord64#    :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "stg_remWord64"     remWord64#     :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "stg_and64"         and64#         :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "stg_or64"          or64#          :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "stg_xor64"         xor64#         :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "stg_not64"         not64#         :: Word64# -> Word64#
+foreign import ccall unsafe "stg_shiftL64"      shiftL64#      :: Word64# -> Int# -> Word64#
+foreign import ccall unsafe "stg_shiftRL64"     shiftRL64#     :: Word64# -> Int# -> Word64#
+
+foreign import ccall unsafe "stg_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64#
 
 
 {-# RULES
diff --git a/Makefile b/Makefile
index 6c72f48..96e1c73 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.8 2002/01/02 15:13:23 simonmar Exp $
+# $Id: Makefile,v 1.9 2002/02/05 17:32:24 simonmar Exp $
 
 TOP=..
 include $(TOP)/mk/boilerplate.mk
@@ -31,6 +31,7 @@ ALL_DIRS = \
 	System/Mem \
 	System/IO \
 	Text \
+	Text/Html \
 	Text/PrettyPrint \
 	Text/Regex \
 	Text/Show
diff --git a/Numeric.hs b/Numeric.hs
index cef75f4..9a2b6cc 100644
--- a/Numeric.hs
+++ b/Numeric.hs
@@ -1,14 +1,14 @@
 -----------------------------------------------------------------------------
 -- 
 -- Module      :  Numeric
--- Copyright   :  (c) The University of Glasgow 2001
+-- Copyright   :  (c) The University of Glasgow 2002
 -- License     :  BSD-style (see the file libraries/core/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
+-- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Numeric.hs,v 1.3 2002/01/02 14:40:09 simonmar Exp $
+-- $Id: Numeric.hs,v 1.4 2002/02/05 17:32:24 simonmar Exp $
 --
 -- Odds and ends, mostly functions for reading and showing
 -- RealFloat-like kind of values.
@@ -20,34 +20,28 @@ module Numeric (
         fromRat,          -- :: (RealFloat a) => Rational -> a
 	showSigned,       -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
 	readSigned,       -- :: (Real a) => ReadS a -> ReadS a
-	showInt,          -- :: Integral a => a -> ShowS
+
 	readInt,          -- :: (Integral a) => a -> (Char -> Bool)
 			  --         -> (Char -> Int) -> ReadS a
-	
 	readDec,          -- :: (Integral a) => ReadS a
 	readOct,          -- :: (Integral a) => ReadS a
 	readHex,          -- :: (Integral a) => ReadS a
 
+	showInt,          -- :: Integral a => a -> ShowS
+        showIntAtBase,    -- :: Integral a => a -> (a -> Char) -> a -> ShowS
         showHex,          -- :: Integral a => a -> ShowS
         showOct,          -- :: Integral a => a -> ShowS
         showBin,          -- :: Integral a => a -> ShowS
-      
+
 	showEFloat,       -- :: (RealFloat a) => Maybe Int -> a -> ShowS
 	showFFloat,       -- :: (RealFloat a) => Maybe Int -> a -> ShowS
 	showGFloat,       -- :: (RealFloat a) => Maybe Int -> a -> ShowS
 	showFloat,        -- :: (RealFloat a) => a -> ShowS
 	readFloat,        -- :: (RealFloat a) => ReadS a
 	
-	 
 	floatToDigits,    -- :: (RealFloat a) => Integer -> a -> ([Int], Int)
 	lexDigits,        -- :: ReadS String
 
-          -- general purpose number->string converter.
-        showIntAtBase,    -- :: Integral a 
-			  -- => a		-- base
-			  -- -> (a -> Char)      -- digit to char
-			  -- -> a                -- number to show.
-			  -- -> ShowS
 	) where
 
 import Prelude		-- For dependencies
diff --git a/System/Directory.hsc b/System/Directory.hs
similarity index 87%
rename from System/Directory.hsc
rename to System/Directory.hs
index c3a4f72..d487294 100644
--- a/System/Directory.hsc
+++ b/System/Directory.hs
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Directory.hsc,v 1.1 2001/08/17 12:45:27 simonmar Exp $
+-- $Id: Directory.hs,v 1.1 2002/02/05 17:32:27 simonmar Exp $
 --
 -- System-independent interface to directory manipulation.
 --
@@ -71,11 +71,6 @@ import GHC.Posix
 import GHC.IOBase	( IOException(..), IOErrorType(..), ioException )
 #endif
 
--- to get config.h
-#include "HsCore.h"
-
-#include <limits.h>
-
 -----------------------------------------------------------------------------
 -- Permissions
 
@@ -129,11 +124,7 @@ createDirectory :: FilePath -> IO ()
 createDirectory path = do
     withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
-#if defined(mingw32_TARGET_OS)
-        c_mkdir s
-#else
-        c_mkdir s 0o777
-#endif
+	mkdir s 0o777
 
 {-
 @removeDirectory dir@ removes an existing directory {\em dir}.  The
@@ -304,7 +295,7 @@ Either path refers to an existing directory.
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath =
-   withFileStatus opath $ \st -> do
+   withFileOrSymlinkStatus opath $ \st -> do
    is_dir <- isDirectory st
    if is_dir
 	then ioException (IOError Nothing InappropriateType "renameFile"
@@ -344,35 +335,35 @@ The path refers to an existing non-directory object.
 
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do
-   p <- withCString path $ \s ->
+   alloca $ \ ptr_dEnt -> do
+    p <- withCString path $ \s ->
 	  throwErrnoIfNullRetry "getDirectoryContents" (c_opendir s)
-   loop p
+    loop ptr_dEnt p
   where
-    loop :: Ptr CDir -> IO [String]
-    loop dir = do
+    loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
+    loop ptr_dEnt dir = do
       resetErrno
-      p <- c_readdir dir
-      if (p /= nullPtr)
+      r <- readdir dir ptr_dEnt
+      if (r == 0) 
 	 then do
-#ifdef mingw32_TARGET_OS
-                 entryp <- (#peek struct dirent,d_name) p
-                 entry <- peekCString entryp -- on mingwin it's a char *, not a char []
-#else
-                 entry <- peekCString ((#ptr struct dirent,d_name) p)
-#endif
-		 entries <- loop dir
-		 return (entry:entries)
+	         dEnt    <- peek ptr_dEnt
+		 if (dEnt == nullPtr) 
+		   then return []
+		   else do
+	 	    entry   <- (d_name dEnt >>= peekCString)
+		    freeDirEnt dEnt
+		    entries <- loop ptr_dEnt dir
+		    return (entry:entries)
 	 else do errno <- getErrno
-		 if (errno == eINTR) then loop dir else do
+		 if (errno == eINTR) then loop ptr_dEnt dir else do
 		 throwErrnoIfMinus1_ "getDirectoryContents" $ c_closedir dir
-#ifdef mingw32_TARGET_OS
-		 if (errno == eNOENT) -- mingwin (20001111) cunningly sets errno to ENOENT when it runs out of files
-#else
-		 if (errno == eOK)
-#endif
+		 let (Errno eo) = errno
+		 if (eo == end_of_dir)
 		    then return []
 		    else throwErrno "getDirectoryContents"
 
+
+
 {-
 If the operating system has a notion of current directories,
 @getCurrentDirectory@ returns an absolute path to the
@@ -398,8 +389,8 @@ The operating system has no notion of current directory.
 
 getCurrentDirectory :: IO FilePath
 getCurrentDirectory = do
-  p <- mallocBytes (#const PATH_MAX)
-  go p (#const PATH_MAX)
+  p <- mallocBytes path_max
+  go p path_max
   where go p bytes = do
     	  p' <- c_getcwd p (fromIntegral bytes)
 	  if p' /= nullPtr 
@@ -474,9 +465,9 @@ getModificationTime name =
 getPermissions :: FilePath -> IO Permissions
 getPermissions name = do
   withCString name $ \s -> do
-  read  <- c_access s (#const R_OK)
-  write <- c_access s (#const W_OK)
-  exec  <- c_access s (#const X_OK)
+  read  <- c_access s r_OK
+  write <- c_access s w_OK
+  exec  <- c_access s x_OK
   withFileStatus name $ \st -> do
   is_dir <- isDirectory st
   is_reg <- isRegularFile st
@@ -492,9 +483,9 @@ getPermissions name = do
 setPermissions :: FilePath -> Permissions -> IO ()
 setPermissions name (Permissions r w e s) = do
     let
-     read  = if r      then (#const S_IRUSR) else emptyCMode
-     write = if w      then (#const S_IWUSR) else emptyCMode
-     exec  = if e || s then (#const S_IXUSR) else emptyCMode
+     read  = if r      then s_IRUSR else emptyCMode
+     write = if w      then s_IWUSR else emptyCMode
+     exec  = if e || s then s_IXUSR else emptyCMode
 
      mode  = read `unionCMode` (write `unionCMode` exec)
 
@@ -503,34 +494,59 @@ setPermissions name (Permissions r w e s) = do
 
 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 withFileStatus name f = do
-    allocaBytes (#const sizeof(struct stat)) $ \p ->
+    allocaBytes sizeof_stat $ \p ->
       withCString name $ \s -> do
         throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
 	f p
 
+withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileOrSymlinkStatus name f = do
+    allocaBytes sizeof_stat $ \p ->
+      withCString name $ \s -> do
+        throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
+	f p
+
 modificationTime :: Ptr CStat -> IO ClockTime
 modificationTime stat = do
-    mtime <- (#peek struct stat, st_mtime) stat
+    mtime <- st_mtime stat
     return (TOD (toInteger (mtime :: CTime)) 0)
-
+    
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do
-  mode <- (#peek struct stat, st_mode) stat
-  return (s_ISDIR mode /= 0)
+  mode <- st_mode stat
+  return (s_isdir mode)
 
 isRegularFile :: Ptr CStat -> IO Bool
 isRegularFile stat = do
-  mode <- (#peek struct stat, st_mode) stat
-  return (s_ISREG mode /= 0)
-
-foreign import ccall unsafe s_ISDIR :: CMode -> Int
-#def inline HsInt s_ISDIR(m) {return S_ISDIR(m);}
-
-foreign import ccall unsafe s_ISREG :: CMode -> Int
-#def inline HsInt s_ISREG(m) {return S_ISREG(m);}
+  mode <- st_mode stat
+  return (s_isreg mode)
 
 emptyCMode     :: CMode
 emptyCMode     = 0
 
 unionCMode     :: CMode -> CMode -> CMode
 unionCMode     = (+)
+
+
+foreign import ccall unsafe "__hscore_path_max"
+  path_max :: Int
+
+foreign import ccall unsafe "__hscore_readdir"
+  readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+  freeDirEnt  :: Ptr CDirent -> IO ()
+
+foreign import ccall unsafe "__hscore_end_of_dir"
+  end_of_dir :: CInt
+
+foreign import ccall unsafe "__hscore_d_name"
+  d_name :: Ptr CDirent -> IO CString
+
+foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
+foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
+foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
+
+foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
diff --git a/System/IO.hs b/System/IO.hs
index fa34c15..3ea7a51 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: IO.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
+-- $Id: IO.hs,v 1.3 2002/02/05 17:32:27 simonmar Exp $
 --
 -- The standard IO library.
 --
@@ -108,6 +108,7 @@ import GHC.Show
 
 import Data.Dynamic
 import Control.Monad.Fix
+import System.IO.Error
 
 -- -----------------------------------------------------------------------------
 -- MonadFix instance
diff --git a/System/IO/Error.hs b/System/IO/Error.hs
new file mode 100644
index 0000000..22becfb
--- /dev/null
+++ b/System/IO/Error.hs
@@ -0,0 +1,186 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+
+-----------------------------------------------------------------------------
+-- 
+-- Module      :  System.IO.Error
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- $Id: Error.hs,v 1.1 2002/02/05 17:32:27 simonmar Exp $
+--
+-- Standard IO Errors.
+--
+-----------------------------------------------------------------------------
+
+module System.IO.Error (
+    IOError,			-- abstract
+    IOErrorType,		-- abstract
+
+    ioError,		       	-- :: IOError -> IO a
+    userError,		       	-- :: String  -> IOError
+
+    mkIOError,			-- :: IOErrorType -> String -> Maybe Handle
+				--    -> Maybe FilePath -> IOError
+
+    alreadyExistsErrorType,	-- :: IOErrorType
+    doesNotExistErrorType,
+    alreadyInUseErrorType,
+    fullErrorType,
+    eofErrorType,
+    illegalOperationErrorType, 
+    permissionErrorType,
+    userErrorType,
+
+    isAlreadyExistsErrorType,	-- :: IOErrorType -> Bool
+    isDoesNotExistErrorType,
+    isAlreadyInUseErrorType,
+    isFullErrorType, 
+    isEOFErrorType,
+    isIllegalOperationErrorType, 
+    isPermissionErrorType,
+    isUserErrorType, 
+
+    isAlreadyExistsError,	-- :: IOError -> Bool
+    isDoesNotExistError,
+    isAlreadyInUseError,
+    isFullError, 
+    isEOFError,
+    isIllegalOperation, 
+    isPermissionError,
+    isUserError,
+
+    ioeGetErrorType,		-- :: IOError -> IOErrorType
+    ioeGetErrorString,		-- :: IOError -> String
+    ioeGetHandle,		-- :: IOError -> Maybe Handle
+    ioeGetFileName,		-- :: IOError -> Maybe FilePath
+
+  ) where
+
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Base
+import Data.Maybe
+import GHC.IOBase
+import Text.Show
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Constructing an IOError
+
+mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
+mkIOError t location maybe_hdl maybe_filename =
+   IOException IOError{ ioe_type = t, 
+			ioe_location = location,
+	   		ioe_descr = "",
+			ioe_handle = maybe_hdl, 
+			ioe_filename = maybe_filename
+ 			}
+
+-- -----------------------------------------------------------------------------
+-- IOErrorType
+
+isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
+ isFullError, isEOFError, isIllegalOperation, isPermissionError,
+ isUserError :: IOError -> Bool
+
+isAlreadyExistsError = isAlreadyExistsErrorType    . ioeGetErrorType
+isDoesNotExistError  = isDoesNotExistErrorType     . ioeGetErrorType
+isAlreadyInUseError  = isAlreadyInUseErrorType     . ioeGetErrorType
+isFullError          = isFullErrorType             . ioeGetErrorType
+isEOFError           = isEOFErrorType              . ioeGetErrorType
+isIllegalOperation   = isIllegalOperationErrorType . ioeGetErrorType
+isPermissionError    = isPermissionErrorType       . ioeGetErrorType
+isUserError          = isUserErrorType             . ioeGetErrorType
+
+-- -----------------------------------------------------------------------------
+-- IOErrorTypes
+
+#ifdef __GLASGOW_HASKELL__
+alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType,
+ fullErrorType, eofErrorType, illegalOperationErrorType,
+ permissionErrorType, userErrorType :: IOErrorType
+
+alreadyExistsErrorType    = AlreadyExists
+doesNotExistErrorType     = NoSuchThing
+alreadyInUseErrorType     = ResourceBusy
+fullErrorType             = ResourceExhausted
+eofErrorType              = EOF
+illegalOperationErrorType = IllegalOperation
+permissionErrorType       = PermissionDenied
+userErrorType		  = UserError
+#endif
+
+-- -----------------------------------------------------------------------------
+-- IOErrorType predicates
+
+#ifdef __GLASGOW_HASKELL__
+isAlreadyExistsErrorType AlreadyExists = True
+isAlreadyExistsErrorType _ = False
+
+isDoesNotExistErrorType NoSuchThing = True
+isDoesNotExistErrorType _ = False
+
+isAlreadyInUseErrorType ResourceBusy = True
+isAlreadyInUseErrorType _ = False
+
+isFullErrorType ResourceExhausted = True
+isFullErrorType _ = False
+
+isEOFErrorType EOF = True
+isEOFErrorType _ = False
+
+isIllegalOperationErrorType IllegalOperation = True
+isIllegalOperationErrorType _ = False
+
+isPermissionErrorType PermissionDenied = True
+isPermissionErrorType _ = False
+
+isUserErrorType UserError = True
+isUserErrorType _ = False
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Miscellaneous
+
+#ifdef __GLASGOW_HASKELL__
+ioeGetErrorType	      :: IOError -> IOErrorType
+ioeGetFileName        :: IOError -> Maybe FilePath
+ioeGetErrorString     :: IOError -> String
+ioeGetHandle          :: IOError -> Maybe Handle
+
+ioeGetErrorType (IOException ioe) = ioe_type ioe
+ioeGetHandle _ = error "System.IO.Error.ioeGetHandle: not an IO error"
+
+ioeGetHandle (IOException ioe) = ioe_handle ioe
+ioeGetHandle _ = error "System.IO.Error.ioeGetHandle: not an IO error"
+
+ioeGetErrorString (IOException ioe) 
+   | isUserErrorType (ioe_type ioe) = show (ioe_descr ioe)
+   | otherwise                      = show (ioe_type ioe)
+ioeGetErrorString _ = error "System.IO.Error.ioeGetErrorString: not an IO error"
+
+ioeGetFileName (IOException ioe) = ioe_filename ioe
+ioeGetFileName _ = error "System.IO.Error.ioeGetFileName: not an IO error"
+#endif
+
+-- -----------------------------------------------------------------------------
+-- annotating an IOError
+
+#ifdef __GLASGOW_HASKELL__
+annotateIOError :: IOError 
+              -> String 
+              -> Maybe FilePath 
+              -> Maybe Handle 
+              -> IOError 
+annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = 
+  IOException (IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath))
+  where
+    Nothing `mplus` ys = ys
+    xs      `mplus` _  = xs
+annotateIOError exc _ _ _ = 
+  exc
+#endif
diff --git a/System/Time.hsc b/System/Time.hsc
index e5cf6b0..326d4f7 100644
--- a/System/Time.hsc
+++ b/System/Time.hsc
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Time.hsc,v 1.6 2001/12/21 15:07:26 simonmar Exp $
+-- $Id: Time.hsc,v 1.7 2002/02/05 17:32:27 simonmar Exp $
 --
 -- The standard Time library.
 --
@@ -321,8 +321,6 @@ foreign label tzname :: Ptr (Ptr CChar)
 #  else
 foreign import "ghcTimezone" unsafe timezone :: Ptr CLong
 foreign import "ghcTzname" unsafe tzname :: Ptr (Ptr CChar)
-#   def inline long  *ghcTimezone(void) { return &_timezone; }
-#   def inline char **ghcTzname(void) { return _tzname; }
 #  endif
 zone x = do 
   dst <- (#peek struct tm,tm_isdst) x
diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c
index a224004..bad1c0f 100644
--- a/cbits/dirUtils.c
+++ b/cbits/dirUtils.c
@@ -1,75 +1,58 @@
 /* 
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-
+ * (c) The University of Glasgow 2002
  *
  * Directory Runtime Support
  */
-#include "dirUtils.h"
+#include "HsCore.h"
 
 #if defined(mingw32_TARGET_OS)
 #include <windows.h>
 #endif
 
-#ifdef HAVE_STDLIB_H
-# include <stdlib.h>
-#endif
-#ifdef HAVE_STDDEF_H
-# include <stddef.h>
-#endif
-#ifdef HAVE_ERRNO_H
-# include <errno.h>
-#endif
-
+/*
+ * read an entry from the directory stream; opt for the
+ * re-entrant friendly way of doing this, if available.
+ */
 HsInt
-prel_mkdir(HsAddr pathName, HsInt mode)
+__hscore_readdir( HsAddr dirPtr, HsAddr pDirEnt )
 {
-#if defined(mingw32_TARGET_OS)
-  return mkdir(pathName);
+  struct dirent **pDirE = (struct dirent**)pDirEnt;
+#if HAVE_READDIR_R
+  struct dirent* p;
+  int res;
+  static unsigned int nm_max = -1;
+  
+  if (pDirE == NULL) {
+    return -1;
+  }
+  if (nm_max == -1) {
+#ifdef NAME_MAX
+    nm_max = NAME_MAX + 1;
 #else
-  return mkdir(pathName,mode);
+    nm_max = pathconf(".", _PC_NAME_MAX);
+    if (nm_max == -1) { nm_max = 255; }
+    nm_max++;
 #endif
-}
-
-HsInt
-prel_lstat(HsAddr fname, HsAddr st)
-{
-#ifdef HAVE_LSTAT
-  return lstat((const char*)fname, (struct stat*)st);
+  }
+  p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max);
+  if (p == NULL) return -1;
+  res = readdir_r((DIR*)dirPtr, p, pDirE);
+  if (res != 0) {
+    *pDirE = NULL;
+    free(p);
+  }
+  return res;
 #else
-  return stat((const char*)fname, (struct stat*)st);
-#endif
-}
-
-HsInt prel_s_ISDIR(mode_t m) {return S_ISDIR(m);}
-HsInt prel_s_ISREG(mode_t m) {return S_ISREG(m);}
-
-HsInt prel_sz_stat()  { return sizeof(struct stat); }
-HsInt prel_path_max() { return PATH_MAX; }
-mode_t prel_R_OK() { return R_OK; }
-mode_t prel_W_OK() { return W_OK; }
-mode_t prel_X_OK() { return X_OK; }
 
-mode_t prel_S_IRUSR() { return S_IRUSR; }
-mode_t prel_S_IWUSR() { return S_IWUSR; }
-mode_t prel_S_IXUSR() { return S_IXUSR; }
+  if (pDirE == NULL) {
+    return -1;
+  }
 
-time_t prel_st_mtime(struct stat* st) { return st->st_mtime; }
-mode_t prel_st_mode(struct stat* st) { return st->st_mode; }
-
-HsAddr prel_d_name(struct dirent* d)
-{ 
-#ifndef mingw32_TARGET_OS
-  return (HsAddr)(&d->d_name);
-#else
-  return (HsAddr)(d->d_name);
+  *pDirE = readdir((DIR*)dirPtr);
+  if (*pDirE == NULL) {
+    return -1;
+  } else {
+    return 0;
+  }  
 #endif
 }
-
-HsInt prel_end_of_dir()
-{
-#ifndef mingw32_TARGET_OS
-  return 0;
-#else
-  return ENOENT;
-#endif  
-}
-
diff --git a/core.conf.in b/core.conf.in
index 00fcca4..0d17573 100644
--- a/core.conf.in
+++ b/core.conf.in
@@ -14,10 +14,19 @@ Package {
         library_dirs   = [ "$libdir/libraries/core"
                          , "$libdir/libraries/core/cbits" ],
 #endif
-        hs_libraries      = [ "HScore" ],
+        hs_libraries      =
+#                           ifndef mingw32_TARGET_OS
+                            [ "HScore" ],
+#                           else
+                            -- This splitting is the subject of a totally 
+                            -- horrible hack, which glues HSstd1 and HSstd2 
+                            -- back into HSstd for the purposes of static linking.
+                            -- See DriverState.getPackageLibraries for details.
+                            [ "HScore1", "HScore2" ],
+#                           endif
 	extra_libraries   = [ "HScore_cbits"
 #ifdef mingw32_TARGET_OS
-                            , "wsock32", "msvcrt"
+                            , "wsock32", "msvcrt", "kernel32", "user32"
 #endif
 			    ],
 #ifdef INSTALLING
diff --git a/include/HsCore.h b/include/HsCore.h
index 305a1ae..0091bb1 100644
--- a/include/HsCore.h
+++ b/include/HsCore.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HsCore.h,v 1.6 2002/01/02 14:40:11 simonmar Exp $
+ * $Id: HsCore.h,v 1.7 2002/02/05 17:32:27 simonmar Exp $
  *
  * (c) The University of Glasgow 2001-2002
  *
@@ -175,14 +175,104 @@ __hscore_o_binary()
 #endif
 }
 
+INLINE int
+__hscore_o_rdonly()
+{
+#ifdef O_RDONLY
+  return O_RDONLY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_wronly( void )
+{
+#ifdef O_WRONLY
+  return O_WRONLY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_rdwr( void )
+{
+#ifdef O_RDWR
+  return O_RDWR;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_append( void )
+{
+#ifdef O_APPEND
+  return O_APPEND;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_creat( void )
+{
+#ifdef O_CREAT
+  return O_CREAT;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_excl( void )
+{
+#ifdef O_EXCL
+  return O_EXCL;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_trunc( void )
+{
+#ifdef O_TRUNC
+  return O_TRUNC;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_noctty( void )
+{
+#ifdef O_NOCTTY
+  return O_NOCTTY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_nonblock( void )
+{
+#ifdef O_NONBLOCK
+  return O_NONBLOCK;
+#else
+  return 0;
+#endif
+}
+
 INLINE HsInt
-__hscore_seek_set()
+__hscore_seek_set( void )
 {
   return SEEK_SET;
 }
 
 INLINE HsInt
-__hscore_seek_end()
+__hscore_seek_end( void )
 {
   return SEEK_END;
 }
@@ -222,5 +312,209 @@ __hscore_PrelHandle_read( HsInt fd, HsBool isSock, HsAddr ptr,
 
 }
 
+#ifdef mingw32_TARGET_OS
+INLINE long *
+__hscore_Time_ghcTimezone( void ) { return &_timezone; }
+
+INLINE char **
+__hscore_Time_ghcTzname( void ) { return _tzname; }
+#endif
+
+INLINE HsInt
+__hscore_mkdir( HsAddr pathName, HsInt mode )
+{
+#if defined(mingw32_TARGET_OS)
+  return mkdir(pathName);
+#else
+  return mkdir(pathName,mode);
+#endif
+}
+
+INLINE HsInt
+__hscore_lstat( HsAddr fname, HsAddr st )
+{
+#ifdef HAVE_LSTAT
+  return lstat((const char*)fname, (struct stat*)st);
+#else
+  return stat((const char*)fname, (struct stat*)st);
+#endif
+}
+
+INLINE HsInt __hscore_path_max() { return PATH_MAX; }
+
+INLINE mode_t __hscore_R_OK() { return R_OK; }
+INLINE mode_t __hscore_W_OK() { return W_OK; }
+INLINE mode_t __hscore_X_OK() { return X_OK; }
+
+INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; }
+INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; }
+INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; }
+
+INLINE HsAddr
+__hscore_d_name( struct dirent* d )
+{ 
+#ifndef mingw32_TARGET_OS
+  return (HsAddr)(&d->d_name);
+#else
+  return (HsAddr)(d->d_name);
+#endif
+}
+
+INLINE HsInt
+__hscore_end_of_dir( void )
+{
+#ifndef mingw32_TARGET_OS
+  return 0;
+#else
+  return ENOENT;
+#endif  
+}
+
+INLINE void
+__hscore_free_dirent(HsAddr dEnt)
+{
+#if HAVE_READDIR_R
+  free(dEnt);
+#endif
+}
+
+INLINE HsInt
+__hscore_sizeof_stat( void )
+{
+  return sizeof(struct stat);
+}
+
+INLINE time_t __hscore_st_mtime ( struct stat* st ) { return st->st_mtime; }
+INLINE off_t  __hscore_st_size  ( struct stat* st ) { return st->st_size; }
+INLINE mode_t __hscore_st_mode  ( struct stat* st ) { return st->st_mode; }
+
+#if HAVE_TERMIOS_H
+INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }
+
+INLINE void
+__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }
+
+INLINE unsigned char*
+__hscore_ptr_c_cc( struct termios* ts ) 
+{ return (unsigned char*) &ts->c_cc; }
+#endif
+
+INLINE HsInt
+__hscore_sizeof_termios( void )
+{
+#ifndef mingw32_TARGET_OS
+  return sizeof(struct termios);
+#else
+  return 0;
+#endif
+}
+
+INLINE HsInt
+__hscore_sizeof_sigset_t( void )
+{
+#ifndef mingw32_TARGET_OS
+  return sizeof(sigset_t);
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_echo( void )
+{
+#ifdef ECHO
+  return ECHO;
+#else
+  return 0;
+#endif
+
+}
+
+INLINE int
+__hscore_tcsanow( void )
+{
+#ifdef TCSANOW
+  return TCSANOW;
+#else
+  return 0;
+#endif
+
+}
+
+INLINE int
+__hscore_icanon( void )
+{
+#ifdef ICANON
+  return ICANON;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_vmin( void )
+{
+#ifdef VMIN
+  return VMIN;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_vtime( void )
+{
+#ifdef VTIME
+  return VTIME;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sigttou( void )
+{
+#ifdef SIGTTOU
+  return SIGTTOU;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sig_block( void )
+{
+#ifdef SIG_BLOCK
+  return SIG_BLOCK;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sig_setmask( void )
+{
+#ifdef SIG_SETMASK
+  return SIG_SETMASK;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_f_getfl( void )
+{
+#ifdef F_GETFL
+  return F_GETFL;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_f_setfl( void )
+{
+#ifdef F_SETFL
+  return F_SETFL;
+#else
+  return 0;
+#endif
+}
+
 #endif
 
diff --git a/include/dirUtils.h b/include/dirUtils.h
index 5f52c03..fb91ba1 100644
--- a/include/dirUtils.h
+++ b/include/dirUtils.h
@@ -1,36 +1,11 @@
 /* 
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-
+ * (c) The University of Glasgow 2002
  *
- * Directory Runtime Support - prototypes.
+ * Directory Runtime Support
  */
 #ifndef __DIRUTILS_H__
 #define __DIRUTILS_H__
 
-#include "HsCore.h"
-
-#include <limits.h>
-
-extern HsInt prel_mkdir(HsAddr pathName, HsInt mode);
-extern HsInt prel_lstat(HsAddr fname, HsAddr st);
-
-extern HsInt prel_s_ISDIR(mode_t m);
-extern HsInt prel_s_ISREG(mode_t m);
-
-extern HsInt prel_sz_stat();
-extern HsInt prel_path_max();
-extern mode_t prel_R_OK();
-extern mode_t prel_W_OK();
-extern mode_t prel_X_OK();
-
-extern mode_t prel_S_IRUSR();
-extern mode_t prel_S_IWUSR();
-extern mode_t prel_S_IXUSR();
-
-extern time_t prel_st_mtime(struct stat* st);
-extern mode_t prel_st_mode(struct stat* st);
-
-extern HsAddr prel_d_name(struct dirent* d);
-
-extern HsInt prel_end_of_dir();
+extern HsInt __hscore_readdir(HsAddr dirPtr, HsAddr pDirEnt);
 
 #endif /* __DIRUTILS_H__ */
-- 
1.7.10.4