[project @ 2001-12-21 15:07:20 by simonmar]
authorsimonmar <unknown>
Fri, 21 Dec 2001 15:07:26 +0000 (15:07 +0000)
committersimonmar <unknown>
Fri, 21 Dec 2001 15:07:26 +0000 (15:07 +0000)
Merge up to the ghc/lib/std on the HEAD (tagged as
new-libraries-last-merged).

57 files changed:
Control/Concurrent.hs
Control/Exception.hs
Control/Monad/ST.hs
Control/Monad/ST/Lazy.hs
Data/Bits.hs
Data/Complex.hs
Data/Dynamic.hs
Data/IORef.hs
Data/Ix.hs
Data/List.hs
Data/Tuple.hs
Debug/QuickCheck/Utils.hs
Foreign/C/Error.hs
Foreign/Marshal/Alloc.hs
GHC/Arr.lhs
GHC/Base.lhs
GHC/Conc.lhs
GHC/Enum.lhs
GHC/Float.lhs
GHC/Handle.hs [moved from GHC/Handle.hsc with 86% similarity]
GHC/IO.hs [moved from GHC/IO.hsc with 87% similarity]
GHC/IOBase.lhs
GHC/Int.lhs
GHC/List.lhs
GHC/Num.lhs
GHC/Posix.hsc
GHC/Prim.hi-boot.pp [moved from GHC/Prim.hi-boot with 88% similarity]
GHC/Ptr.lhs
GHC/Read.lhs
GHC/Real.lhs
GHC/ST.lhs
GHC/STRef.lhs
GHC/Show.lhs
GHC/Storable.lhs
GHC/Weak.lhs
GHC/Word.lhs
Makefile
System/CPUTime.hsc
System/Environment.hs
System/Mem/StableName.hs
System/Random.hs
System/Time.hsc
cbits/PrelIOUtils.c [new file with mode: 0644]
cbits/dirUtils.c [new file with mode: 0644]
cbits/errno.c
cbits/ilxstubs.c
cbits/inputReady.c
cbits/longlong.c
cbits/system.c
cbits/writeError.c
doc/libraries.sgml
include/CTypes.h
include/HsCore.h
include/PackedString.h [deleted file]
include/PrelIOUtils.h [new file with mode: 0644]
include/dirUtils.h [new file with mode: 0644]
include/errUtils.h [new file with mode: 0644]

index 1409b75..db570bf 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Concurrent.hs,v 1.2 2001/08/07 15:25:04 simonmar Exp $
+-- $Id: Concurrent.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
 --
 -- A common interface to a collection of useful concurrency
 -- abstractions.
@@ -53,8 +53,7 @@ import GHC.Conc
 import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase      ( IO(..) )
 import GHC.IOBase      ( unsafeInterleaveIO )
-import GHC.Base                ( fork# )
-import GHC.Prim                ( Addr#, unsafeCoerce# )
+import GHC.Base
 #endif
 
 #ifdef __HUGS__
index abd0861..529d364 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Exception.hs,v 1.4 2001/10/18 11:14:17 rrt Exp $
+-- $Id: Exception.hs,v 1.5 2001/12/21 15:07:21 simonmar Exp $
 --
 -- The External API for exceptions.  The functions provided in this
 -- module allow catching of exceptions in the IO monad.
@@ -76,7 +76,7 @@ module Control.Exception (
 
 #ifdef __GLASGOW_HASKELL__
 import Prelude                 hiding (catch)
-import GHC.Prim                ( assert )
+import GHC.Base                ( assert )
 import GHC.Exception   hiding (try, catch, bracket, bracket_)
 import GHC.Conc                ( throwTo, ThreadId )
 import GHC.IOBase      ( IO(..) )
index 5f47360..dd7829c 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable (requires universal quantification for runST)
 --
--- $Id: ST.hs,v 1.4 2001/07/31 13:31:44 simonmar Exp $
+-- $Id: ST.hs,v 1.5 2001/12/21 15:07:21 simonmar Exp $
 --
 -- The State Transformer Monad, ST
 --
@@ -34,7 +34,7 @@ import Data.Dynamic
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.ST
-import GHC.Prim                ( unsafeCoerce#, RealWorld )
+import GHC.Base                ( unsafeCoerce#, RealWorld )
 import GHC.IOBase      ( IO(..), stToIO )
 
 -- This relies on IO and ST having the same representation modulo the
index 5144dcc..5d3c557 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  non-portable (requires universal quantification for runST)
 --
--- $Id: Lazy.hs,v 1.2 2001/07/03 11:37:49 simonmar Exp $
+-- $Id: Lazy.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
 --
 -- This module presents an identical interface to Control.Monad.ST,
 -- but the underlying implementation of the state thread is lazy.
@@ -47,10 +47,9 @@ import Data.Array
 import qualified Control.Monad.ST as ST
 import qualified GHC.Arr as STArray
 import qualified GHC.ST
-import GHC.Base        ( ($), ()(..) )
+import GHC.Base
 import Control.Monad
 import Data.Ix
-import GHC.Prim
 #endif
 
 #ifdef __HUGS__
index 9b68618..8303545 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Bits.hs,v 1.2 2001/07/03 11:37:49 simonmar Exp $
+-- $Id: Bits.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
 --
 -- Bitwise operations.
 --
@@ -92,20 +92,13 @@ instance Bits Int where
         | i# >=# 0#            = I# (x# `iShiftL#` i#)
         | otherwise            = I# (x# `iShiftRA#` negateInt# i#)
     (I# x#) `rotate` (I# i#) =
-#if WORD_SIZE_IN_BYTES == 4
         I# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                       (x'# `shiftRL#` (32# -# i'#))))
+                       (x'# `shiftRL#` (wsib -# i'#))))
         where
         x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
-#else
-        I# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                       (x'# `shiftRL#` (64# -# i'#))))
-        where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
-#endif
-    bitSize  _                 = WORD_SIZE_IN_BYTES * 8
+        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+       wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+    bitSize  _                 = WORD_SIZE_IN_BITS
     isSigned _                 = True
 
 instance Bits Integer where
index e132f21..8482e50 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Complex.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- $Id: Complex.hs,v 1.2 2001/12/21 15:07:21 simonmar Exp $
 --
 -- Complex numbers.
 --
@@ -58,24 +58,30 @@ realPart, imagPart :: (RealFloat a) => Complex a -> a
 realPart (x :+ _) =  x
 imagPart (_ :+ y) =  y
 
+{-# SPECIALISE conjugate :: Complex Double -> Complex Double #-}
 conjugate       :: (RealFloat a) => Complex a -> Complex a
 conjugate (x:+y) =  x :+ (-y)
 
+{-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-}
 mkPolar                 :: (RealFloat a) => a -> a -> Complex a
 mkPolar r theta         =  r * cos theta :+ r * sin theta
 
+{-# SPECIALISE cis :: Double -> Complex Double #-}
 cis             :: (RealFloat a) => a -> Complex a
 cis theta       =  cos theta :+ sin theta
 
+{-# SPECIALISE polar :: Complex Double -> (Double,Double) #-}
 polar           :: (RealFloat a) => Complex a -> (a,a)
 polar z                 =  (magnitude z, phase z)
 
+{-# SPECIALISE magnitude :: Complex Double -> Double #-}
 magnitude :: (RealFloat a) => Complex a -> a
 magnitude (x:+y) =  scaleFloat k
                     (sqrt ((scaleFloat mk x)^(2::Int) + (scaleFloat mk y)^(2::Int)))
                    where k  = max (exponent x) (exponent y)
                          mk = - k
 
+{-# SPECIALISE phase :: Complex Double -> Double #-}
 phase :: (RealFloat a) => Complex a -> a
 phase (0 :+ 0)   = 0           -- SLPJ July 97 from John Peterson
 phase (x:+y)    = atan2 y x
index e8643a3..356d084 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Dynamic.hs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
+-- $Id: Dynamic.hs,v 1.4 2001/12/21 15:07:21 simonmar Exp $
 --
 -- The Dynamic interface provides basic support for dynamic types.
 -- 
@@ -78,8 +78,6 @@ import GHC.Dynamic
 #endif
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Prim                        ( unsafeCoerce# )
-
 unsafeCoerce :: a -> b
 unsafeCoerce = unsafeCoerce#
 #endif
index dcc0eae..910ea86 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: IORef.hs,v 1.2 2001/07/03 11:37:49 simonmar Exp $
+-- $Id: IORef.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
 --
 -- Mutable references in the IO monad.
 --
@@ -29,7 +29,7 @@ module Data.IORef
 import Prelude
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Prim                ( mkWeak# )
+import GHC.Base                ( mkWeak# )
 import GHC.STRef
 import GHC.IOBase
 #if !defined(__PARALLEL_HASKELL__)
index 8d4d745..5296e11 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Ix.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- $Id: Ix.hs,v 1.2 2001/12/21 15:07:21 simonmar Exp $
 --
 -- Class of index types.
 --
@@ -20,8 +20,8 @@ module Data.Ix
          ( range       -- :: (Ix a) => (a,a) -> [a]
          , index       -- :: (Ix a) => (a,a) -> a   -> Int
          , inRange     -- :: (Ix a) => (a,a) -> a   -> Bool
+         , rangeSize   -- :: (Ix a) => (a,a) -> Int
          )
-    ,  rangeSize       -- :: (Ix a) => (a,a) -> Int
     -- Ix instances:
     --
     --  Ix Char
index ce4c9b3..9082db5 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: List.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- $Id: List.hs,v 1.2 2001/12/21 15:07:21 simonmar Exp $
 --
 -- Operations on lists.
 --
@@ -317,13 +317,21 @@ insertBy cmp x ys@(y:ys')
      GT -> y : insertBy cmp x ys'
      _  -> x : ys
 
-maximumBy              :: (a -> a -> a) -> [a] -> a
-maximumBy _   []       =  error "List.maximumBy: empty list"
-maximumBy max xs       =  foldl1 max xs
-
-minimumBy              :: (a -> a -> a) -> [a] -> a
-minimumBy _   []       =  error "List.minimumBy: empty list"
-minimumBy min xs       =  foldl1 min xs
+maximumBy              :: (a -> a -> Ordering) -> [a] -> a
+maximumBy _ []         =  error "List.maximumBy: empty list"
+maximumBy cmp xs       =  foldl1 max xs
+                       where
+                          max x y = case cmp x y of
+                                       GT -> x
+                                       _  -> y
+
+minimumBy              :: (a -> a -> Ordering) -> [a] -> a
+minimumBy _ []         =  error "List.minimumBy: empty list"
+minimumBy cmp xs       =  foldl1 min xs
+                       where
+                          min x y = case cmp x y of
+                                       GT -> y
+                                       _  -> x
 
 genericLength           :: (Num i) => [b] -> i
 genericLength []        =  0
index f1fc78c..d37642a 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Tuple.hs,v 1.1 2001/07/03 11:38:07 simonmar Exp $
+-- $Id: Tuple.hs,v 1.2 2001/12/21 15:07:22 simonmar Exp $
 --
 -- The tuple data types, and associated functions.
 --
@@ -30,20 +30,20 @@ import GHC.Base
 default ()             -- Double isn't available yet
 #endif
 
-data (,) a b = (,) a b   deriving (Eq, Ord)
+data (,) a b = (,) a b deriving (Eq, Ord)
 data (,,) a b c = (,,) a b c deriving (Eq, Ord)
 data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord)
 data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord)
-data (,,,,,) a b c d e f = (,,,,,) a b c d e f
-data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
-data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
-data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
-data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
-data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
-data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
-data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
-data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
-data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
+data (,,,,,) a b c d e f = (,,,,,) a b c d e f deriving (Eq, Ord)
+data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g deriving (Eq, Ord)
+data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h deriving (Eq, Ord)
+data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i deriving (Eq, Ord)
+data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j deriving (Eq, Ord)
+data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k deriving (Eq, Ord)
+data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l deriving (Eq, Ord)
+data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m deriving (Eq, Ord)
+data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n deriving (Eq, Ord)
+data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o deriving (Eq, Ord)
 data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
 data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
  = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
index f6ad91f..a8c2df5 100644 (file)
@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- 
--- Module      :  Debug.QuickCheck.Poly
+-- Module      :  Debug.QuickCheck.Utils
 -- Copyright   :  (c) Andy Gill 2001
 -- License     :  BSD-style (see the file libraries/core/LICENSE)
 -- 
@@ -8,13 +8,13 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Utils.hs,v 1.1 2001/08/17 12:48:38 simonmar Exp $
+-- $Id: Utils.hs,v 1.2 2001/12/21 15:07:22 simonmar Exp $
 --
 -- These are some general purpose utilities for use with QuickCheck.
 --
 -----------------------------------------------------------------------------
 
-module Debug.QuickCheckUtils
+module Debug.QuickCheck.Utils
   ( isAssociativeBy
   , isAssociative
   , isCommutableBy
index 71a05ac..b0d3a91 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Error.hs,v 1.3 2001/07/31 12:59:30 simonmar Exp $
+-- $Id: Error.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
 --
 -- C-specific Marshalling support: Handling of C "errno" error codes
 --
@@ -120,6 +120,7 @@ import System.IO            ( IOError, Handle, ioError )
 -- import of C function that gives address of errno
 -- 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
 
 -- Haskell representation for "errno" values
@@ -148,108 +149,108 @@ eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, 
   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                   :: Errno
 --
--- the CCONST_XXX identifiers are cpp symbols whose value is computed by
+-- the cCONST_XXX identifiers are cpp symbols whose value is computed by
 -- configure 
 --
 eOK             = Errno 0
-e2BIG           = Errno (CCONST_E2BIG)
-eACCES         = Errno (CCONST_EACCES)
-eADDRINUSE     = Errno (CCONST_EADDRINUSE)
-eADDRNOTAVAIL  = Errno (CCONST_EADDRNOTAVAIL)
-eADV           = Errno (CCONST_EADV)
-eAFNOSUPPORT   = Errno (CCONST_EAFNOSUPPORT)
-eAGAIN         = Errno (CCONST_EAGAIN)
-eALREADY       = Errno (CCONST_EALREADY)
-eBADF          = Errno (CCONST_EBADF)
-eBADMSG                = Errno (CCONST_EBADMSG)
-eBADRPC                = Errno (CCONST_EBADRPC)
-eBUSY          = Errno (CCONST_EBUSY)
-eCHILD         = Errno (CCONST_ECHILD)
-eCOMM          = Errno (CCONST_ECOMM)
-eCONNABORTED   = Errno (CCONST_ECONNABORTED)
-eCONNREFUSED   = Errno (CCONST_ECONNREFUSED)
-eCONNRESET     = Errno (CCONST_ECONNRESET)
-eDEADLK                = Errno (CCONST_EDEADLK)
-eDESTADDRREQ   = Errno (CCONST_EDESTADDRREQ)
-eDIRTY         = Errno (CCONST_EDIRTY)
-eDOM           = Errno (CCONST_EDOM)
-eDQUOT         = Errno (CCONST_EDQUOT)
-eEXIST         = Errno (CCONST_EEXIST)
-eFAULT         = Errno (CCONST_EFAULT)
-eFBIG          = Errno (CCONST_EFBIG)
-eFTYPE         = Errno (CCONST_EFTYPE)
-eHOSTDOWN      = Errno (CCONST_EHOSTDOWN)
-eHOSTUNREACH   = Errno (CCONST_EHOSTUNREACH)
-eIDRM          = Errno (CCONST_EIDRM)
-eILSEQ         = Errno (CCONST_EILSEQ)
-eINPROGRESS    = Errno (CCONST_EINPROGRESS)
-eINTR          = Errno (CCONST_EINTR)
-eINVAL         = Errno (CCONST_EINVAL)
-eIO            = Errno (CCONST_EIO)
-eISCONN                = Errno (CCONST_EISCONN)
-eISDIR         = Errno (CCONST_EISDIR)
-eLOOP          = Errno (CCONST_ELOOP)
-eMFILE         = Errno (CCONST_EMFILE)
-eMLINK         = Errno (CCONST_EMLINK)
-eMSGSIZE       = Errno (CCONST_EMSGSIZE)
-eMULTIHOP      = Errno (CCONST_EMULTIHOP)
-eNAMETOOLONG   = Errno (CCONST_ENAMETOOLONG)
-eNETDOWN       = Errno (CCONST_ENETDOWN)
-eNETRESET      = Errno (CCONST_ENETRESET)
-eNETUNREACH    = Errno (CCONST_ENETUNREACH)
-eNFILE         = Errno (CCONST_ENFILE)
-eNOBUFS                = Errno (CCONST_ENOBUFS)
-eNODATA                = Errno (CCONST_ENODATA)
-eNODEV         = Errno (CCONST_ENODEV)
-eNOENT         = Errno (CCONST_ENOENT)
-eNOEXEC                = Errno (CCONST_ENOEXEC)
-eNOLCK         = Errno (CCONST_ENOLCK)
-eNOLINK                = Errno (CCONST_ENOLINK)
-eNOMEM         = Errno (CCONST_ENOMEM)
-eNOMSG         = Errno (CCONST_ENOMSG)
-eNONET         = Errno (CCONST_ENONET)
-eNOPROTOOPT    = Errno (CCONST_ENOPROTOOPT)
-eNOSPC         = Errno (CCONST_ENOSPC)
-eNOSR          = Errno (CCONST_ENOSR)
-eNOSTR         = Errno (CCONST_ENOSTR)
-eNOSYS         = Errno (CCONST_ENOSYS)
-eNOTBLK                = Errno (CCONST_ENOTBLK)
-eNOTCONN       = Errno (CCONST_ENOTCONN)
-eNOTDIR                = Errno (CCONST_ENOTDIR)
-eNOTEMPTY      = Errno (CCONST_ENOTEMPTY)
-eNOTSOCK       = Errno (CCONST_ENOTSOCK)
-eNOTTY         = Errno (CCONST_ENOTTY)
-eNXIO          = Errno (CCONST_ENXIO)
-eOPNOTSUPP     = Errno (CCONST_EOPNOTSUPP)
-ePERM          = Errno (CCONST_EPERM)
-ePFNOSUPPORT   = Errno (CCONST_EPFNOSUPPORT)
-ePIPE          = Errno (CCONST_EPIPE)
-ePROCLIM       = Errno (CCONST_EPROCLIM)
-ePROCUNAVAIL   = Errno (CCONST_EPROCUNAVAIL)
-ePROGMISMATCH  = Errno (CCONST_EPROGMISMATCH)
-ePROGUNAVAIL   = Errno (CCONST_EPROGUNAVAIL)
-ePROTO         = Errno (CCONST_EPROTO)
-ePROTONOSUPPORT = Errno (CCONST_EPROTONOSUPPORT)
-ePROTOTYPE     = Errno (CCONST_EPROTOTYPE)
-eRANGE         = Errno (CCONST_ERANGE)
-eREMCHG                = Errno (CCONST_EREMCHG)
-eREMOTE                = Errno (CCONST_EREMOTE)
-eROFS          = Errno (CCONST_EROFS)
-eRPCMISMATCH   = Errno (CCONST_ERPCMISMATCH)
-eRREMOTE       = Errno (CCONST_ERREMOTE)
-eSHUTDOWN      = Errno (CCONST_ESHUTDOWN)
-eSOCKTNOSUPPORT = Errno (CCONST_ESOCKTNOSUPPORT)
-eSPIPE         = Errno (CCONST_ESPIPE)
-eSRCH          = Errno (CCONST_ESRCH)
-eSRMNT         = Errno (CCONST_ESRMNT)
-eSTALE         = Errno (CCONST_ESTALE)
-eTIME          = Errno (CCONST_ETIME)
-eTIMEDOUT      = Errno (CCONST_ETIMEDOUT)
-eTOOMANYREFS   = Errno (CCONST_ETOOMANYREFS)
-eTXTBSY                = Errno (CCONST_ETXTBSY)
-eUSERS         = Errno (CCONST_EUSERS)
-eWOULDBLOCK    = Errno (CCONST_EWOULDBLOCK)
-eXDEV          = Errno (CCONST_EXDEV)
+e2BIG           = Errno (cCONST_E2BIG)
+eACCES         = Errno (cCONST_EACCES)
+eADDRINUSE     = Errno (cCONST_EADDRINUSE)
+eADDRNOTAVAIL  = Errno (cCONST_EADDRNOTAVAIL)
+eADV           = Errno (cCONST_EADV)
+eAFNOSUPPORT   = Errno (cCONST_EAFNOSUPPORT)
+eAGAIN         = Errno (cCONST_EAGAIN)
+eALREADY       = Errno (cCONST_EALREADY)
+eBADF          = Errno (cCONST_EBADF)
+eBADMSG                = Errno (cCONST_EBADMSG)
+eBADRPC                = Errno (cCONST_EBADRPC)
+eBUSY          = Errno (cCONST_EBUSY)
+eCHILD         = Errno (cCONST_ECHILD)
+eCOMM          = Errno (cCONST_ECOMM)
+eCONNABORTED   = Errno (cCONST_ECONNABORTED)
+eCONNREFUSED   = Errno (cCONST_ECONNREFUSED)
+eCONNRESET     = Errno (cCONST_ECONNRESET)
+eDEADLK                = Errno (cCONST_EDEADLK)
+eDESTADDRREQ   = Errno (cCONST_EDESTADDRREQ)
+eDIRTY         = Errno (cCONST_EDIRTY)
+eDOM           = Errno (cCONST_EDOM)
+eDQUOT         = Errno (cCONST_EDQUOT)
+eEXIST         = Errno (cCONST_EEXIST)
+eFAULT         = Errno (cCONST_EFAULT)
+eFBIG          = Errno (cCONST_EFBIG)
+eFTYPE         = Errno (cCONST_EFTYPE)
+eHOSTDOWN      = Errno (cCONST_EHOSTDOWN)
+eHOSTUNREACH   = Errno (cCONST_EHOSTUNREACH)
+eIDRM          = Errno (cCONST_EIDRM)
+eILSEQ         = Errno (cCONST_EILSEQ)
+eINPROGRESS    = Errno (cCONST_EINPROGRESS)
+eINTR          = Errno (cCONST_EINTR)
+eINVAL         = Errno (cCONST_EINVAL)
+eIO            = Errno (cCONST_EIO)
+eISCONN                = Errno (cCONST_EISCONN)
+eISDIR         = Errno (cCONST_EISDIR)
+eLOOP          = Errno (cCONST_ELOOP)
+eMFILE         = Errno (cCONST_EMFILE)
+eMLINK         = Errno (cCONST_EMLINK)
+eMSGSIZE       = Errno (cCONST_EMSGSIZE)
+eMULTIHOP      = Errno (cCONST_EMULTIHOP)
+eNAMETOOLONG   = Errno (cCONST_ENAMETOOLONG)
+eNETDOWN       = Errno (cCONST_ENETDOWN)
+eNETRESET      = Errno (cCONST_ENETRESET)
+eNETUNREACH    = Errno (cCONST_ENETUNREACH)
+eNFILE         = Errno (cCONST_ENFILE)
+eNOBUFS                = Errno (cCONST_ENOBUFS)
+eNODATA                = Errno (cCONST_ENODATA)
+eNODEV         = Errno (cCONST_ENODEV)
+eNOENT         = Errno (cCONST_ENOENT)
+eNOEXEC                = Errno (cCONST_ENOEXEC)
+eNOLCK         = Errno (cCONST_ENOLCK)
+eNOLINK                = Errno (cCONST_ENOLINK)
+eNOMEM         = Errno (cCONST_ENOMEM)
+eNOMSG         = Errno (cCONST_ENOMSG)
+eNONET         = Errno (cCONST_ENONET)
+eNOPROTOOPT    = Errno (cCONST_ENOPROTOOPT)
+eNOSPC         = Errno (cCONST_ENOSPC)
+eNOSR          = Errno (cCONST_ENOSR)
+eNOSTR         = Errno (cCONST_ENOSTR)
+eNOSYS         = Errno (cCONST_ENOSYS)
+eNOTBLK                = Errno (cCONST_ENOTBLK)
+eNOTCONN       = Errno (cCONST_ENOTCONN)
+eNOTDIR                = Errno (cCONST_ENOTDIR)
+eNOTEMPTY      = Errno (cCONST_ENOTEMPTY)
+eNOTSOCK       = Errno (cCONST_ENOTSOCK)
+eNOTTY         = Errno (cCONST_ENOTTY)
+eNXIO          = Errno (cCONST_ENXIO)
+eOPNOTSUPP     = Errno (cCONST_EOPNOTSUPP)
+ePERM          = Errno (cCONST_EPERM)
+ePFNOSUPPORT   = Errno (cCONST_EPFNOSUPPORT)
+ePIPE          = Errno (cCONST_EPIPE)
+ePROCLIM       = Errno (cCONST_EPROCLIM)
+ePROCUNAVAIL   = Errno (cCONST_EPROCUNAVAIL)
+ePROGMISMATCH  = Errno (cCONST_EPROGMISMATCH)
+ePROGUNAVAIL   = Errno (cCONST_EPROGUNAVAIL)
+ePROTO         = Errno (cCONST_EPROTO)
+ePROTONOSUPPORT = Errno (cCONST_EPROTONOSUPPORT)
+ePROTOTYPE     = Errno (cCONST_EPROTOTYPE)
+eRANGE         = Errno (cCONST_ERANGE)
+eREMCHG                = Errno (cCONST_EREMCHG)
+eREMOTE                = Errno (cCONST_EREMOTE)
+eROFS          = Errno (cCONST_EROFS)
+eRPCMISMATCH   = Errno (cCONST_ERPCMISMATCH)
+eRREMOTE       = Errno (cCONST_ERREMOTE)
+eSHUTDOWN      = Errno (cCONST_ESHUTDOWN)
+eSOCKTNOSUPPORT = Errno (cCONST_ESOCKTNOSUPPORT)
+eSPIPE         = Errno (cCONST_ESPIPE)
+eSRCH          = Errno (cCONST_ESRCH)
+eSRMNT         = Errno (cCONST_ESRMNT)
+eSTALE         = Errno (cCONST_ESTALE)
+eTIME          = Errno (cCONST_ETIME)
+eTIMEDOUT      = Errno (cCONST_ETIMEDOUT)
+eTOOMANYREFS   = Errno (cCONST_ETOOMANYREFS)
+eTXTBSY                = Errno (cCONST_ETXTBSY)
+eUSERS         = Errno (cCONST_EUSERS)
+eWOULDBLOCK    = Errno (cCONST_EWOULDBLOCK)
+eXDEV          = Errno (cCONST_EXDEV)
 
 -- checks whether the given errno value is supported on the current
 -- architecture
@@ -457,7 +458,7 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
         | errno == eNFILE          = ResourceExhausted
         | errno == eNOBUFS         = ResourceExhausted
         | errno == eNODATA         = NoSuchThing
-        | errno == eNODEV          = NoSuchThing
+        | errno == eNODEV          = UnsupportedOperation
         | errno == eNOENT          = NoSuchThing
         | errno == eNOEXEC         = InvalidArgument
         | errno == eNOLCK          = ResourceExhausted
@@ -513,3 +514,106 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
 #endif
 
 foreign import 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
+
index ce5f1c3..6080d0c 100644 (file)
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Alloc.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: Alloc.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
 --
 -- Marshalling support: basic routines for memory allocation
 --
@@ -39,7 +39,6 @@ import GHC.Real
 import GHC.Ptr
 import GHC.Err
 import GHC.Base
-import GHC.Prim
 #endif
 
 
index 940b603..bc8b809 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Arr.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+% $Id: Arr.lhs,v 1.2 2001/12/21 15:07:22 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -37,17 +37,38 @@ default ()
 %*********************************************************
 
 \begin{code}
-class  (Ord a) => Ix a  where
+class (Ord a) => Ix a where
     range              :: (a,a) -> [a]
     index, unsafeIndex :: (a,a) -> a -> Int
     inRange            :: (a,a) -> a -> Bool
+    rangeSize          :: (a,a) -> Int
+    unsafeRangeSize     :: (a,a) -> Int
 
        -- Must specify one of index, unsafeIndex
     index b i | inRange b i = unsafeIndex b i
              | otherwise   = error "Error in array index"
     unsafeIndex b i = index b i
+
+       -- As long as you don't override the default rangeSize, 
+       -- you can specify unsafeRangeSize as follows, to speed up
+       -- some operations:
+       --
+       --    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+       --
+    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
+                      | otherwise   = 0
+    unsafeRangeSize b = rangeSize b
 \end{code}
 
+Note that the following is NOT right
+       rangeSize (l,h) | l <= h    = index b h + 1
+                       | otherwise = 0
+
+Because it might be the case that l<h, but the range
+is nevertheless empty.  Consider
+       ((1,2),(2,1))
+Here l<h, but the second index ranges from 2..1 and
+hence is empty
 
 %*********************************************************
 %*                                                     *
@@ -80,6 +101,8 @@ instance  Ix Char  where
 
     inRange (m,n) i    =  m <= i && i <= n
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
 ----------------------------------------------------------------------
 instance  Ix Int  where
     {-# INLINE range #-}
@@ -96,6 +119,8 @@ instance  Ix Int  where
     {-# INLINE inRange #-}
     inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
 ----------------------------------------------------------------------
 instance  Ix Integer  where
     {-# INLINE range #-}
@@ -109,6 +134,7 @@ instance  Ix Integer  where
 
     inRange (m,n) i    =  m <= i && i <= n
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 ----------------------------------------------------------------------
 instance Ix Bool where -- as derived
@@ -123,6 +149,8 @@ instance Ix Bool where -- as derived
 
     inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
 ----------------------------------------------------------------------
 instance Ix Ordering where -- as derived
     {-# INLINE range #-}
@@ -136,6 +164,8 @@ instance Ix Ordering where -- as derived
 
     inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
 ----------------------------------------------------------------------
 instance Ix () where
     {-# INLINE range #-}
@@ -147,6 +177,7 @@ instance Ix () where
     {-# INLINE index #-}
     index b i = unsafeIndex b i
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 ----------------------------------------------------------------------
 instance (Ix a, Ix b) => Ix (a, b) where -- as derived
@@ -164,6 +195,8 @@ instance (Ix a, Ix b) => Ix (a, b) where -- as derived
     inRange ((l1,l2),(u1,u2)) (i1,i2) =
       inRange (l1,u1) i1 && inRange (l2,u2) i2
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
     -- Default method for index
 
 ----------------------------------------------------------------------
@@ -184,6 +217,8 @@ instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where
       inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
       inRange (l3,u3) i3
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
     -- Default method for index
 
 ----------------------------------------------------------------------
@@ -204,6 +239,8 @@ instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where
       inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
       inRange (l3,u3) i3 && inRange (l4,u4) i4
 
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
     -- Default method for index
 
 instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where
@@ -226,40 +263,9 @@ instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where
       inRange (l3,u3) i3 && inRange (l4,u4) i4 && 
       inRange (l5,u5) i5
 
-    -- Default method for index
-\end{code}
-
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
-%********************************************************
-%*                                                     *
-\subsection{Size of @Ix@ interval}
-%*                                                     *
-%********************************************************
-
-The @rangeSize@ operator returns the number of elements
-in the range for an @Ix@ pair.
-
-\begin{code}
-{-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
-{-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
-unsafeRangeSize :: (Ix a) => (a,a) -> Int
-unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
-
-{-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
-{-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
-rangeSize :: (Ix a) => (a,a) -> Int
-rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
-                  | otherwise   = 0
-
--- Note that the following is NOT right
---     rangeSize (l,h) | l <= h    = index b h + 1
---                     | otherwise = 0
---
--- Because it might be the case that l<h, but the range
--- is nevertheless empty.  Consider
---     ((1,2),(2,1))
--- Here l<h, but the second index ranges from 2..1 and
--- hence is empty
+    -- Default method for index
 \end{code}
 
 %*********************************************************
index e694e84..d9b7908 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Base.lhs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Base.lhs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -85,7 +85,7 @@ module GHC.Base
   ) 
        where
 
-import GHC.Prim
+import {-# SOURCE #-} GHC.Prim
 import {-# SOURCE #-} GHC.Err
 
 infixr 9  .
@@ -243,25 +243,26 @@ The rest of the prelude list functions are in GHC.List.
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
-{-# INLINE foldr #-}
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
 foldr k z xs = go xs
             where
               go []     = z
               go (y:ys) = y `k` go ys
 
 build  :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE 2 build #-}
+{-# INLINE [1] build #-}
        -- The INLINE is important, even though build is tiny,
        -- because it prevents [] getting inlined in the version that
        -- appears in the interface file.  If [] *is* inlined, it
        -- won't match with [] appearing in rules in an importing module.
        --
-       -- The "2" says to inline in phase 2
+       -- The "1" says to inline in phase 1
 
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE 2 augment #-}
+{-# INLINE [1] augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
@@ -274,8 +275,16 @@ augment g xs = g (:) xs
 "foldr/id"     foldr (:) [] = \x->x
 "foldr/app"            forall xs ys. foldr (:) ys xs = append xs ys
 
-"foldr/cons"   forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/nil"    forall k z.      foldr k z []     = z 
+-- The foldr/cons rule looks nice, but it can give disastrously
+-- bloated code when commpiling
+--     array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
+-- i.e. when there are very very long literal lists
+-- So I've disabled it for now. We could have special cases
+-- for short lists, I suppose.
+-- "foldr/cons"        forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+
+"foldr/single" forall k z x. foldr k z [x] = k x z
+"foldr/nil"    forall k z.   foldr k z []  = z 
 
 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
                       (h::forall b. (a->b->b) -> b -> b) .
@@ -295,6 +304,7 @@ augment g xs = g (:) xs
 
 \begin{code}
 map :: (a -> b) -> [a] -> [b]
+{-# NOINLINE [1] map #-}
 map = mapList
 
 -- Note eta expanded
@@ -318,6 +328,7 @@ mapList f (x:xs) = f x : mapList f xs
 ----------------------------------------------
 \begin{code}
 (++) :: [a] -> [a] -> [a]
+{-# NOINLINE [1] (++) #-}
 (++) = append
 
 {-# RULES
@@ -449,9 +460,14 @@ String equality is used when desugaring pattern-matches against strings.
 
 \begin{code}
 eqString :: String -> String -> Bool
-eqString = (==)
+eqString []       []      = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString cs1      cs2     = False
+
+{-# RULES "eqString" (==) = eqString #-}
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Type @Int@}
@@ -465,10 +481,15 @@ zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 zeroInt = I# 0#
 oneInt  = I# 1#
 twoInt  = I# 2#
-#if WORD_SIZE_IN_BYTES == 4
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt  = I# (-0x40000000#)
+maxInt  = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
 minInt  = I# (-0x80000000#)
 maxInt  = I# 0x7FFFFFFF#
-#else
+#else 
 minInt  = I# (-0x8000000000000000#)
 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 #endif
@@ -657,10 +678,37 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 "x# <=# x#" forall x#. x# <=# x# = True
   #-}
 
-#if WORD_SIZE_IN_BYTES == 4
+-- Wrappers for the shift operations.  The uncheckedShift# family are
+-- undefined when the amount being shifted by is greater than the size
+-- in bits of Int#, so these wrappers perform a check and return
+-- either zero or -1 appropriately.
+--
+-- Note that these wrappers still produce undefined results when the
+-- second argument (the shift amount) is negative.
+
+shiftL#, shiftRL# :: Word# -> Int# -> Word#
+
+a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftL#` b
+
+a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftRL#` b
+
+iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
+
+a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftL#` b
+
+a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
+               | otherwise                = a `uncheckedIShiftRA#` b
+
+a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftRL#` b
+
+#if WORD_SIZE_IN_BITS == 32
 {-# RULES
-"intToInt32#"   forall x#. intToInt32#   x# = x#
-"wordToWord32#" forall x#. wordToWord32# x# = x#
+"narrow32Int#"  forall x#. narrow32Int#   x# = x#
+"narrow32Word#" forall x#. narrow32Word#   x# = x#
    #-}
 #endif
 
@@ -682,6 +730,7 @@ unpacking the strings of error messages.
 
 \begin{code}
 unpackCString# :: Addr# -> [Char]
+{-# NOINLINE [1] unpackCString# #-}
 unpackCString# a = unpackCStringList# a
 
 unpackCStringList# :: Addr# -> [Char]
@@ -705,6 +754,9 @@ unpackAppendCString# addr rest
        ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
+{-# NOINLINE [0] unpackFoldrCString# #-}
+-- Don't inline till right at the end;
+-- usually the unpack-list rule turns it into unpackCStringList
 unpackFoldrCString# addr f z 
   = unpack 0#
   where
@@ -722,18 +774,18 @@ unpackCStringUtf8# addr
       | ch `eqChar#` '\0'#   = []
       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
       | ch `leChar#` '\xDF'# =
-          C# (chr# ((ord# ch                                  -# 0xC0#) `iShiftL#`  6# +#
+          C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
           unpack (nh +# 2#)
       | ch `leChar#` '\xEF'# =
-          C# (chr# ((ord# ch                                  -# 0xE0#) `iShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#`  6# +#
+          C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
           unpack (nh +# 3#)
       | otherwise            =
-          C# (chr# ((ord# ch                                  -# 0xF0#) `iShiftL#` 18# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#`  6# +#
+          C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
index b847a85..5a74f32 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Conc.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Conc.lhs,v 1.3 2001/12/21 15:07:22 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -19,7 +19,7 @@ module GHC.Conc
        , killThread    -- :: ThreadId -> IO ()
        , throwTo       -- :: ThreadId -> Exception -> IO ()
        , par           -- :: a -> b -> b
-       , seq           -- :: a -> b -> b
+       , pseq          -- :: a -> b -> b
        , yield         -- :: IO ()
 
        -- Waiting
@@ -48,7 +48,7 @@ import GHC.IOBase     ( IO(..), MVar(..) )
 import GHC.Base                ( Int(..) )
 import GHC.Exception    ( Exception(..), AsyncException(..) )
 
-infixr 0 `par`, `seq`
+infixr 0 `par`, `pseq`
 \end{code}
 
 %************************************************************************
@@ -81,7 +81,10 @@ yield :: IO ()
 yield = IO $ \s -> 
    case (yield# s) of s1 -> (# s1, () #)
 
--- "seq" is defined a bit weirdly (see below)
+--     Nota Bene: 'pseq' used to be 'seq'
+--                but 'seq' is now defined in PrelGHC
+--
+-- "pseq" is defined a bit weirdly (see below)
 --
 -- The reason for the strange "0# -> parError" case is that
 -- it fools the compiler into thinking that seq is non-strict in
@@ -92,9 +95,9 @@ yield = IO $ \s ->
 -- Just before converting from Core to STG there's a bit of magic
 -- that recognises the seq# and eliminates the duff case.
 
-{-# INLINE seq  #-}
-seq :: a -> b -> b
-seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
+{-# INLINE pseq  #-}
+pseq :: a -> b -> b
+pseq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
 
 {-# INLINE par  #-}
 par :: a -> b -> b
index 1391b1f..7e5f9d9 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Enum.lhs,v 1.5 2001/07/31 13:06:51 simonmar Exp $
+% $Id: Enum.lhs,v 1.6 2001/12/21 15:07:22 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -205,11 +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)
@@ -222,7 +224,7 @@ efdtChar = efdtCharList
 
 -- We can do better than for Ints because we don't
 -- have hassles about arithmetic overflow at maxBound
-{-# INLINE eftCharFB #-}
+{-# INLINE [0] eftCharFB #-}
 eftCharFB c n x y = go x
                 where
                    go x | x ># y    = n
@@ -233,6 +235,7 @@ eftCharList x y | x ># y    = []
 
 
 -- For enumFromThenTo we give up on inlining
+{-# NOINLINE [0] efdCharFB #-}
 efdCharFB c n x1 x2
   | delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF#
   | otherwise    = go_dn_char_fb c n x1 delta 0#
@@ -245,6 +248,7 @@ efdCharList x1 x2
   where
     delta = x2 -# x1
 
+{-# NOINLINE [0] efdtCharFB #-}
 efdtCharFB c n x1 x2 lim
   | delta >=# 0# = go_up_char_fb c n x1 delta lim
   | otherwise    = go_dn_char_fb c n x1 delta lim
@@ -313,7 +317,8 @@ instance  Enum Int  where
     fromEnum x = x
 
     {-# INLINE enumFrom #-}
-    enumFrom (I# x) = case maxInt of I# y -> eftInt x y
+    enumFrom (I# x) = eftInt x maxInt#
+        where I# maxInt# = maxInt
        -- Blarg: technically I guess enumFrom isn't strict!
 
     {-# INLINE enumFromTo #-}
@@ -325,6 +330,9 @@ 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
@@ -340,7 +348,7 @@ efdtInt = efdtIntList
  #-}
 
 
-{-# INLINE eftIntFB #-}
+{-# INLINE [0] eftIntFB #-}
 eftIntFB c n x y | x ># y    = n       
                 | otherwise = go x
                 where
@@ -358,6 +366,7 @@ eftIntList x y | x ># y    = []
 
 -- For enumFromThenTo we give up on inlining; so we don't worry
 -- about duplicating occurrences of "c"
+{-# NOINLINE [0] efdtIntFB #-}
 efdtIntFB c n x1 x2 y
   | delta >=# 0# = if x1 ># y then n else go_up_int_fb c n x1 delta lim
   | otherwise    = if x1 <# y then n else go_dn_int_fb c n x1 delta lim 
@@ -372,6 +381,7 @@ efdtIntList x1 x2 y
     delta = x2 -# x1
     lim   = y -# delta
 
+{-# NOINLINE [0] efdIntFB #-}
 efdIntFB c n x1 x2
   | delta >=# 0# = case maxInt of I# y -> go_up_int_fb c n x1 delta (y -# delta)
   | otherwise    = case minInt of I# y -> go_dn_int_fb c n x1 delta (y -# delta)
index 08fa67c..6bd7df4 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Float.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Float.lhs,v 1.3 2001/12/21 15:07:22 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -496,13 +496,15 @@ formatRealFloat fmt decs x
        mk0 ls = case ls of { "" -> "0" ; _ -> ls}
       in
       case decs of
-       Nothing ->
-         let
-         f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
-         f n s    ""  = f (n-1) ('0':s) ""
-         f n s (r:rs) = f (n-1) (r:s) rs
-        in
-        f e "" ds
+       Nothing
+         | e <= 0    -> "0." ++ replicate (-e) '0' ++ ds
+         | otherwise ->
+            let
+               f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
+               f n s    ""  = f (n-1) ('0':s) ""
+               f n s (r:rs) = f (n-1) (r:s) rs
+            in
+               f e "" ds
        Just dec ->
         let dec' = max dec 0 in
        if e >= 0 then
@@ -516,8 +518,8 @@ formatRealFloat fmt decs x
          (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)
          d:ds' = map intToDigit (if ei > 0 then is' else 0:is')
         in
-        d : '.' : ds'
-        
+        d : (if null ds' then "" else '.':ds')
+
 
 roundTo :: Int -> Int -> [Int] -> (Int,[Int])
 roundTo base d is =
@@ -536,13 +538,18 @@ roundTo base d is =
        (c,ds) = f (n-1) xs
        i'     = c + i
 
---
 -- Based on "Printing Floating-Point Numbers Quickly and Accurately"
 -- by R.G. Burger and R.K. Dybvig in PLDI 96.
 -- This version uses a much slower logarithm estimator. It should be improved.
 
--- This function returns a list of digits (Ints in [0..base-1]) and an
--- exponent.
+-- floatToDigits takes a base and a non-negative RealFloat number,
+-- and returns a list of digits and an exponent. 
+-- In particular, if x>=0, and
+--     floatToDigits base x = ([d1,d2,...,dn], e)
+-- then
+--     (a) n >= 1
+--     (b) x = 0.d1d2...dn * (base**e)
+--     (c) 0 <= di <= base-1
 
 floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
 floatToDigits _ 0 = ([0], 0)
@@ -761,6 +768,18 @@ minusFloat  (F# x) (F# y) = F# (minusFloat# x y)
 timesFloat  (F# x) (F# y) = F# (timesFloat# x y)
 divideFloat (F# x) (F# y) = F# (divideFloat# x y)
 
+{-# RULES
+"plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
+"plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
+"minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
+"minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
+"timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
+"timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
+"timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
+"timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
+"divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
+  #-}
+
 negateFloat :: Float -> Float
 negateFloat (F# x)        = F# (negateFloat# x)
 
@@ -807,6 +826,18 @@ minusDouble  (D# x) (D# y) = D# (x -## y)
 timesDouble  (D# x) (D# y) = D# (x *## y)
 divideDouble (D# x) (D# y) = D# (x /## y)
 
+{-# RULES
+"plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
+"plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
+"minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
+"minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
+"timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
+"timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
+"timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
+"timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
+"divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
+  #-}
+
 negateDouble :: Double -> Double
 negateDouble (D# x)        = D# (negateDouble# x)
 
similarity index 86%
rename from GHC/Handle.hsc
rename to GHC/Handle.hs
index cf0956a..94b0203 100644 (file)
@@ -1,10 +1,10 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-}
 
 #undef DEBUG_DUMP
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: Handle.hsc,v 1.6 2001/09/14 11:25:24 simonmar Exp $
+-- $Id: Handle.hs,v 1.1 2001/12/21 15:07:22 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -40,8 +40,6 @@ module GHC.Handle (
 
  ) where
 
-#include "HsCore.h"
-
 import Control.Monad
 import Data.Bits
 import Data.Maybe
@@ -77,8 +75,8 @@ import GHC.Conc
 -- ---------------------------------------------------------------------------
 -- Are files opened by default in text or binary mode, if the user doesn't
 -- specify?
-dEFAULT_OPEN_IN_BINARY_MODE :: Bool
-dEFAULT_OPEN_IN_BINARY_MODE = False
+
+dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
 
 -- ---------------------------------------------------------------------------
 -- Creating a new handle
@@ -226,7 +224,7 @@ checkReadableHandle act handle_ =
        let ref = haBuffer handle_
        buf <- readIORef ref
        when (bufferIsWritable buf) $ do
-          new_buf <- flushWriteBuffer (haFD handle_) buf
+          new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
           writeIORef ref new_buf{ bufState=ReadBuffer }
        act handle_
       _other              -> act handle_
@@ -246,9 +244,9 @@ checkSeekableHandle act handle_ =
       ClosedHandle     -> ioe_closedHandle
       SemiClosedHandle -> ioe_closedHandle
       AppendHandle      -> ioe_notSeekable
-      _                 | haIsBin handle_ -> act handle_
-                        | otherwise       -> ioe_notSeekable_notBin
-
+      _  | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
+         | otherwise                                 -> ioe_notSeekable_notBin
 -- -----------------------------------------------------------------------------
 -- Handy IOErrors
 
@@ -272,8 +270,9 @@ ioe_notSeekable = ioException
        "handle is not seekable" Nothing)
 ioe_notSeekable_notBin = ioException 
    (IOError Nothing IllegalOperation ""
-       "seek operations are only allowed on binary-mode handles" Nothing)
-
+      "seek operations on text-mode handles are not allowed on this platform" 
+        Nothing)
 ioe_bufsiz :: Int -> IO a
 ioe_bufsiz n = ioException 
    (IOError Nothing InvalidArgument "hSetBuffering"
@@ -285,10 +284,9 @@ ioe_bufsiz n = ioException
 
 -- For a duplex handle, we arrange that the read side points to the write side
 -- (and hence keeps it alive if the read side is alive).  This is done by
--- having the haType field of the read side be ReadSideHandle with a pointer
--- to the write side.  The finalizer is then placed on the write side, and
--- the handle only gets finalized once, when both sides are no longer
--- required.
+-- having the haOtherSide field of the read side point to the read side.
+-- The finalizer is then placed on the write side, and the handle only gets
+-- finalized once, when both sides are no longer required.
 
 stdHandleFinalizer :: MVar Handle__ -> IO ()
 stdHandleFinalizer m = do
@@ -301,8 +299,12 @@ handleFinalizer m = do
   flushWriteBufferOnly h_
   let fd = fromIntegral (haFD h_)
   unlockFile fd
-  -- ToDo: closesocket() for a WINSOCK socket?
-  when (fd /= -1) (c_close fd >> return ())
+  when (fd /= -1) 
+#ifdef mingw32_TARGET_OS
+       (closeFd (haIsStream h_) fd >> return ())
+#else
+       (c_close fd >> return ())
+#endif
   return ()
 
 -- ---------------------------------------------------------------------------
@@ -345,8 +347,6 @@ readCharFromBuffer slab (I## off)
   = IO $ \s -> case readCharArray## slab off s of 
                 (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
 
-dEFAULT_BUFFER_SIZE = (#const BUFSIZ) :: Int
-
 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
 getBuffer fd state = do
   buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
@@ -371,7 +371,7 @@ flushWriteBufferOnly h_ = do
       ref = haBuffer h_
   buf <- readIORef ref
   new_buf <- if bufferIsWritable buf 
-               then flushWriteBuffer fd buf 
+               then flushWriteBuffer fd (haIsStream h_) buf 
                else return buf
   writeIORef ref new_buf
 
@@ -385,7 +385,7 @@ flushBuffer h_ = do
   flushed_buf <-
     case bufState buf of
       ReadBuffer  -> flushReadBuffer  (haFD h_) buf
-      WriteBuffer -> flushWriteBuffer (haFD h_) buf
+      WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
 
   writeIORef ref flushed_buf
 
@@ -403,11 +403,11 @@ flushReadBuffer fd buf
      puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
 #    endif
      throwErrnoIfMinus1Retry "flushReadBuffer"
-        (c_lseek (fromIntegral fd) (fromIntegral off) (#const SEEK_CUR))
+        (c_lseek (fromIntegral fd) (fromIntegral off) sSEEK_CUR)
      return buf{ bufWPtr=0, bufRPtr=0 }
 
-flushWriteBuffer :: FD -> Buffer -> IO Buffer
-flushWriteBuffer fd buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
+flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
+flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
   let bytes = w - r
 #ifdef DEBUG_DUMP
   puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
@@ -416,24 +416,24 @@ flushWriteBuffer fd 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) b (fromIntegral r) 
+               (write_off (fromIntegral fd) is_stream b (fromIntegral r)
                        (fromIntegral bytes))
                (threadWaitWrite fd)
   let res' = fromIntegral res
   if res' < bytes 
-     then flushWriteBuffer fd (buf{ bufRPtr = r + res' })
+     then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
      else return buf{ bufRPtr=0, bufWPtr=0 }
 
-foreign import "write_wrap" unsafe
-   write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
+foreign import "__hscore_PrelHandle_write" unsafe
+   write_off :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 
 
-fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
-fillReadBuffer fd is_line 
+fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
+fillReadBuffer fd is_line is_stream
       buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
   -- buffer better be empty:
   assert (r == 0 && w == 0) $ do
-  fillReadBufferLoop fd is_line buf b w size
+  fillReadBufferLoop fd is_line is_stream buf b w size
 
 -- For a line buffer, we just get the first chunk of data to arrive,
 -- and don't wait for the whole buffer to be full (but we *do* wait
@@ -441,7 +441,7 @@ fillReadBuffer fd is_line
 -- appears to be what GHC has done for a long time, and I suspect it
 -- is more useful than line buffering in most cases.
 
-fillReadBufferLoop fd is_line buf b w size = do
+fillReadBufferLoop fd is_line is_stream buf b w size = do
   let bytes = size - w
   if bytes == 0  -- buffer full?
      then return buf{ bufRPtr=0, bufWPtr=w }
@@ -450,7 +450,7 @@ fillReadBufferLoop fd is_line buf b w size = do
   puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
 #endif
   res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
-           (read_off fd b (fromIntegral w) (fromIntegral bytes))
+           (read_off fd is_stream b (fromIntegral w) (fromIntegral bytes))
            (threadWaitRead fd)
   let res' = fromIntegral res
 #ifdef DEBUG_DUMP
@@ -461,11 +461,11 @@ fillReadBufferLoop fd is_line buf b w size = do
             then ioe_EOF
             else return buf{ bufRPtr=0, bufWPtr=w }
      else if res' < bytes && not is_line
-            then fillReadBufferLoop fd is_line buf b (w+res') size
+            then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
             else return buf{ bufRPtr=0, bufWPtr=w+res' }
  
-foreign import "read_wrap" unsafe
-   read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
+foreign import "__hscore_PrelHandle_read" unsafe
+   read_off :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 
 -- ---------------------------------------------------------------------------
 -- Standard Handles
@@ -484,16 +484,7 @@ stdin = unsafePerformIO $ do
    -- ToDo: acquire lock
    setNonBlockingFD fd_stdin
    (buf, bmode) <- getBuffer fd_stdin ReadBuffer
-   spares <- newIORef BufferListNil
-   newFileHandle stdHandleFinalizer
-           (Handle__ { haFD = fd_stdin,
-                       haType = ReadHandle,
-                        haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
-                       haBufferMode = bmode,
-                       haFilePath = "<stdin>",
-                       haBuffer = buf,
-                       haBuffers = spares
-                     })
+   mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
 
 stdout :: Handle
 stdout = unsafePerformIO $ do
@@ -502,16 +493,7 @@ stdout = unsafePerformIO $ do
    -- some shells don't recover properly.
    -- setNonBlockingFD fd_stdout
    (buf, bmode) <- getBuffer fd_stdout WriteBuffer
-   spares <- newIORef BufferListNil
-   newFileHandle stdHandleFinalizer
-           (Handle__ { haFD = fd_stdout,
-                       haType = WriteHandle,
-                        haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
-                       haBufferMode = bmode,
-                       haFilePath = "<stdout>",
-                       haBuffer = buf,
-                       haBuffers = spares
-                     })
+   mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
 
 stderr :: Handle
 stderr = unsafePerformIO $ do
@@ -519,17 +501,8 @@ stderr = unsafePerformIO $ do
    -- We don't set non-blocking mode on stdout or sterr, because
    -- some shells don't recover properly.
    -- setNonBlockingFD fd_stderr
-   buffer <- mkUnBuffer
-   spares <- newIORef BufferListNil
-   newFileHandle stdHandleFinalizer
-           (Handle__ { haFD = fd_stderr,
-                       haType = WriteHandle,
-                        haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
-                       haBufferMode = NoBuffering,
-                       haFilePath = "<stderr>",
-                       haBuffer = buffer,
-                       haBuffers = spares
-                     })
+   buf <- mkUnBuffer
+   mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
 
 -- ---------------------------------------------------------------------------
 -- Opening and Closing Files
@@ -607,9 +580,7 @@ openFile' filepath ex_mode =
               | otherwise         = False
 
       binary_flags
-#ifdef HAVE_O_BINARY
-         | binary    = o_BINARY
-#endif
+         | binary    = PrelHandle.o_BINARY
          | otherwise = 0
 
       oflags = oflags1 .|. binary_flags
@@ -624,7 +595,7 @@ openFile' filepath ex_mode =
              throwErrnoIfMinus1Retry "openFile"
                (c_open f (fromIntegral oflags) 0o666)
 
-    openFd fd filepath mode binary truncate
+    openFd fd Nothing filepath mode binary truncate
        -- ASSERT: if we just created the file, then openFd won't fail
        -- (so we don't need to worry about removing the newly created file
        --  in the event of an error).
@@ -640,8 +611,8 @@ append_flags = write_flags  .|. o_APPEND
 -- ---------------------------------------------------------------------------
 -- openFd
 
-openFd :: FD -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
-openFd fd filepath mode binary truncate = do
+openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
+openFd fd mb_fd_type filepath mode binary truncate = do
     -- turn on non-blocking mode
     setNonBlockingFD fd
 
@@ -654,15 +625,19 @@ openFd fd filepath mode binary truncate = do
 
     -- open() won't tell us if it was a directory if we only opened for
     -- reading, so check again.
-    fd_type <- fdType fd
+    fd_type <- 
+      case mb_fd_type of
+        Just x  -> return x
+       Nothing -> fdType fd
+    let is_stream = fd_type == Stream
     case fd_type of
        Directory -> 
           ioException (IOError Nothing InappropriateType "openFile"
                           "is a directory" Nothing) 
 
        Stream
-          | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
-          | otherwise                  -> mkFileHandle fd filepath ha_type binary
+          | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
+          | otherwise                  -> mkFileHandle fd is_stream filepath ha_type binary
 
        -- regular files need to be locked
        RegularFile -> do
@@ -674,7 +649,7 @@ openFd fd filepath mode binary truncate = do
           -- truncate the file if necessary
           when truncate (fileTruncate filepath)
 
-          mkFileHandle fd filepath ha_type binary
+          mkFileHandle fd is_stream filepath ha_type binary
 
 
 foreign import "lockFile" unsafe
@@ -683,32 +658,52 @@ foreign import "lockFile" unsafe
 foreign import "unlockFile" unsafe
   unlockFile :: CInt -> IO CInt
 
-mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
-mkFileHandle fd filepath ha_type binary = do
+mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
+       -> IO Handle
+mkStdHandle fd filepath ha_type buf bmode = do
+   spares <- newIORef BufferListNil
+   newFileHandle stdHandleFinalizer
+           (Handle__ { haFD = fd,
+                       haType = ha_type,
+                        haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
+                       haIsStream = False,
+                       haBufferMode = bmode,
+                       haFilePath = filepath,
+                       haBuffer = buf,
+                       haBuffers = spares,
+                       haOtherSide = Nothing
+                     })
+
+mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
+mkFileHandle fd is_stream filepath ha_type binary = do
   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
   spares <- newIORef BufferListNil
   newFileHandle handleFinalizer
            (Handle__ { haFD = fd,
                        haType = ha_type,
                         haIsBin = binary,
+                       haIsStream = is_stream,
                        haBufferMode = bmode,
                        haFilePath = filepath,
                        haBuffer = buf,
-                       haBuffers = spares
+                       haBuffers = spares,
+                       haOtherSide = Nothing
                      })
 
-mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
-mkDuplexHandle fd filepath binary = do
+mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
+mkDuplexHandle fd is_stream filepath binary = do
   (w_buf, w_bmode) <- getBuffer fd WriteBuffer
   w_spares <- newIORef BufferListNil
   let w_handle_ = 
             Handle__ { haFD = fd,
                        haType = WriteHandle,
                         haIsBin = binary,
+                       haIsStream = is_stream,
                        haBufferMode = w_bmode,
                        haFilePath = filepath,
                        haBuffer = w_buf,
-                       haBuffers = w_spares
+                       haBuffers = w_spares,
+                       haOtherSide = Nothing
                      }
   write_side <- newMVar w_handle_
 
@@ -716,16 +711,18 @@ mkDuplexHandle fd filepath binary = do
   r_spares <- newIORef BufferListNil
   let r_handle_ = 
             Handle__ { haFD = fd,
-                       haType = ReadSideHandle write_side,
+                       haType = ReadHandle,
                         haIsBin = binary,
+                       haIsStream = is_stream,
                        haBufferMode = r_bmode,
                        haFilePath = filepath,
                        haBuffer = r_buf,
-                       haBuffers = r_spares
+                       haBuffers = r_spares,
+                       haOtherSide = Just write_side
                      }
   read_side <- newMVar r_handle_
 
-  addMVarFinalizer write_side (handleFinalizer write_side)
+  addMVarFinalizer read_side (handleFinalizer read_side)
   return (DuplexHandle read_side write_side)
    
 
@@ -744,22 +741,32 @@ initBufferState _            = WriteBuffer
 
 hClose :: Handle -> IO ()
 hClose h@(FileHandle m)     = hClose' h m
-hClose h@(DuplexHandle r w) = do
-  hClose' h w
-  withHandle__' "hClose" h r $ \ handle_ -> do
-  return handle_{ haFD  = -1,
-                 haType = ClosedHandle
-                }
+hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
 
 hClose' h m = withHandle__' "hClose" h m $ hClose_help
 
+-- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
+-- or an IO error occurs on a lazy stream.  The semi-closed Handle is
+-- then closed immediately.  We have to be careful with DuplexHandles
+-- though: we have to leave the closing to the finalizer in that case,
+-- because the write side may still be in use.
 hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return handle_
       _ -> do
          let fd = fromIntegral (haFD handle_)
          flushWriteBufferOnly handle_
-         throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
+
+         -- close the file descriptor, but not when this is the read side
+         -- of a duplex handle.
+         case haOtherSide handle_ of
+           Nothing -> throwErrnoIfMinus1Retry_ "hClose" 
+#ifdef mingw32_TARGET_OS
+                                               (closeFd (haIsStream handle_) fd)
+#else
+                                               (c_close fd)
+#endif
+           Just _  -> return ()
 
          -- free the spare buffers
          writeIORef (haBuffers handle_) BufferListNil
@@ -827,7 +834,7 @@ hLookAhead handle = do
 
   -- fill up the read buffer if necessary
   new_buf <- if bufferEmpty buf
-               then fillReadBuffer fd is_line buf
+               then fillReadBuffer fd is_line (haIsStream handle_) buf
                else return buf
   
   writeIORef ref new_buf
@@ -916,7 +923,7 @@ hFlush handle =
    wantWritableHandle "hFlush" handle $ \ handle_ -> do
    buf <- readIORef (haBuffer handle_)
    if bufferIsWritable buf && not (bufferEmpty buf)
-       then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
+       then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
                writeIORef (haBuffer handle_) flushed_buf
        else return ()
 
@@ -929,6 +936,10 @@ data HandlePosn = HandlePosn Handle HandlePosition
 instance Eq HandlePosn where
     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 
+instance Show HandlePosn where
+   showsPrec p (HandlePosn h pos) = 
+       showsPrec p h . showString " at position " . shows pos
+
   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
   -- We represent it as an Integer on the Haskell side, but
   -- cheat slightly in that hGetPosn calls upon a C helper
@@ -943,7 +954,7 @@ hGetPosn :: Handle -> IO HandlePosn
 hGetPosn handle =
     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
 
-#if defined(_WIN32)
+#if defined(mingw32_TARGET_OS)
        -- urgh, on Windows we have to worry about \n -> \r\n translation, 
        -- so we can't easily calculate the file position using the
        -- current buffer size.  Just flush instead.
@@ -952,7 +963,7 @@ hGetPosn handle =
       let fd = fromIntegral (haFD handle_)
       posn <- fromIntegral `liftM`
                throwErrnoIfMinus1Retry "hGetPosn"
-                  (c_lseek fd 0 (#const SEEK_CUR))
+                  (c_lseek fd 0 sEEK_CUR)
 
       let ref = haBuffer handle_
       buf <- readIORef ref
@@ -1021,12 +1032,12 @@ hSeek handle mode offset =
 
         whence :: CInt
         whence = case mode of
-                   AbsoluteSeek -> (#const SEEK_SET)
-                   RelativeSeek -> (#const SEEK_CUR)
-                   SeekFromEnd  -> (#const SEEK_END)
+                   AbsoluteSeek -> sEEK_SET
+                   RelativeSeek -> sEEK_CUR
+                   SeekFromEnd  -> sEEK_END
 
     if bufferIsWritable buf
-       then do new_buf <- flushWriteBuffer fd buf
+       then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
                writeIORef ref new_buf
                do_seek
        else do
@@ -1109,7 +1120,9 @@ hIsSeekable handle =
       SemiClosedHandle            -> ioe_closedHandle
       AppendHandle        -> return False
       _                    -> do t <- fdType (haFD handle_)
-                                return (t == RegularFile && haIsBin handle_)
+                                 return (t == RegularFile
+                                         && (haIsBin handle_ 
+                                               || tEXT_MODE_SEEK_ALLOWED))
 
 -- -----------------------------------------------------------------------------
 -- Changing echo status
@@ -1149,21 +1162,14 @@ hIsTerminalDevice handle = do
 -- -----------------------------------------------------------------------------
 -- hSetBinaryMode
 
-#ifdef _WIN32
 hSetBinaryMode handle bin =
   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
-    do let flg | bin       = (#const O_BINARY)
-              | otherwise = (#const O_TEXT)
-       throwErrnoIfMinus1_ "hSetBinaryMode"
-          (setmode (fromIntegral (haFD handle_)) flg)
+    do throwErrnoIfMinus1_ "hSetBinaryMode"
+          (setmode (fromIntegral (haFD handle_)) bin)
        return handle_{haIsBin=bin}
-
-foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
-#else
-hSetBinaryMode handle bin =
-  withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
-    return handle_{haIsBin=bin}
-#endif
+  
+foreign import "__hscore_setmode" unsafe
+  setmode :: CInt -> Bool -> IO CInt
 
 -- -----------------------------------------------------------------------------
 -- Miscellaneous
@@ -1194,3 +1200,17 @@ puts :: String -> IO ()
 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))
                                     return ()
 #endif
+
+-- -----------------------------------------------------------------------------
+-- wrappers to platform-specific constants:
+
+foreign import ccall "__hscore_supportsTextMode" unsafe 
+  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
+
+
similarity index 87%
rename from GHC/IO.hsc
rename to GHC/IO.hs
index ac1e98d..801e683 100644 (file)
+++ b/GHC/IO.hs
@@ -1,9 +1,9 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-}
 
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: IO.hsc,v 1.3 2001/09/14 11:25:24 simonmar Exp $
+-- $Id: IO.hs,v 1.1 2001/12/21 15:07:23 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
 -- but as it happens they also do everything required by library
 -- module IO.
 
-module GHC.IO where
-
-#include "HsCore.h"
+module GHC.IO ( 
+   putChar, putStr, putStrLn, print, getChar, getLine, getContents,
+   interact, readFile, writeFile, appendFile, readLn, readIO, hReady,
+   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
+   hPutStrLn, hPrint,
+   commitBuffer',      -- hack, see below
+   hGetcBuffered,      -- needed by ghc/compiler/utils/StringBuffer.lhs
+   hGetBuf, hPutBuf, slurpFile
+ ) where
 
 import Foreign
 import Foreign.C
@@ -58,11 +64,11 @@ hWaitForInput h msecs = do
        else do
 
   r <- throwErrnoIfMinus1Retry "hReady"
-         (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs))
+         (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
   return (r /= 0)
 
-foreign import "inputReady" 
-  inputReady :: CInt -> CInt -> IO CInt
+foreign import "inputReady" unsafe
+  inputReady :: CInt -> CInt -> Bool -> IO CInt
 
 -- ---------------------------------------------------------------------------
 -- hGetChar
@@ -85,16 +91,16 @@ hGetChar handle =
   -- buffer is empty.
   case haBufferMode handle_ of
     LineBuffering    -> do
-       new_buf <- fillReadBuffer fd True buf
+       new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
        hGetcBuffered fd ref new_buf
     BlockBuffering _ -> do
-       new_buf <- fillReadBuffer fd False buf
+       new_buf <- fillReadBuffer fd False (haIsStream handle_) buf
        hGetcBuffered fd ref new_buf
     NoBuffering -> do
        -- make use of the minimal buffer we already have
        let raw = bufBuf buf
        r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
-               (read_off (fromIntegral fd) raw 0 1)
+               (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
                (threadWaitRead fd)
        if r == 0
           then ioe_EOF
@@ -164,7 +170,7 @@ hGetLineBufferedLoop handle_ ref
                   else writeIORef ref buf{ bufRPtr = off + 1 }
                return (concat (reverse (xs:xss)))
        else do
-            maybe_buf <- maybeFillReadBuffer (haFD handle_) True 
+            maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
                                buf{ bufWPtr=0, bufRPtr=0 }
             case maybe_buf of
                -- Nothing indicates we caught an EOF, and we may have a
@@ -177,9 +183,9 @@ hGetLineBufferedLoop handle_ ref
                     hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
 
 
-maybeFillReadBuffer fd is_line buf
+maybeFillReadBuffer fd is_line is_stream buf
   = catch 
-     (do buf <- fillReadBuffer fd is_line buf
+     (do buf <- fillReadBuffer fd is_line is_stream buf
         return (Just buf)
      )
      (\e -> do if isEOFError e 
@@ -273,9 +279,8 @@ lazyRead' h handle_ = do
      NoBuffering      -> do
        -- make use of the minimal buffer we already have
        let raw = bufBuf buf
-           fd  = haFD handle_
        r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
-               (read_off (fromIntegral fd) raw 0 1)
+               (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
                (threadWaitRead fd)
        if r == 0
           then do handle_ <- hClose_help handle_ 
@@ -291,7 +296,7 @@ lazyRead' h handle_ = do
 -- is_line==True, which tells it to "just read what there is".
 lazyReadBuffered h handle_ fd ref buf = do
    catch 
-       (do buf <- fillReadBuffer fd True{-is_line-} buf
+       (do buf <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
            lazyReadHaveBuffer h handle_ fd ref buf
        )
        -- all I/O errors are discarded.  Additionally, we close the handle.
@@ -346,7 +351,7 @@ hPutcBuffered handle_ is_line c = do
   let new_buf = buf{ bufWPtr = w' }
   if bufferFull new_buf || is_line && c == '\n'
      then do 
-       flushed_buf <- flushWriteBuffer (haFD handle_) new_buf
+       flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf
        writeIORef ref flushed_buf
      else do 
        writeIORef ref new_buf
@@ -424,13 +429,12 @@ writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
        return ()
    shoveString n (c:cs) = do
        n' <- writeCharIntoBuffer raw n c
-       -- we're line-buffered, so flush the buffer if we just got a newline
-       if (c == '\n')
-         then do
-           new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
-           writeLines hdl new_buf cs
-         else do
-           shoveString n' cs
+      if (c == '\n') 
+         then do 
+              new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
+              writeLines hdl new_buf cs
+         else 
+              shoveString n' cs
   in
   shoveString 0 s
 
@@ -476,13 +480,27 @@ commitBuffer
        :: Handle                       -- handle to commit to
        -> RawBuffer -> Int             -- address and size (in bytes) of buffer
        -> Int                          -- number of bytes of data in buffer
-       -> Bool                         -- flush the handle afterward?
+       -> Bool                         -- True <=> flush the handle afterward
        -> Bool                         -- release the buffer?
        -> IO Buffer
 
-commitBuffer hdl raw sz count flush release = do
-  wantWritableHandle "commitAndReleaseBuffer" hdl $ 
-    \ handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } -> do
+commitBuffer hdl raw sz@(I## _) count@(I## _) flush release = do
+  wantWritableHandle "commitAndReleaseBuffer" hdl $
+     commitBuffer' hdl raw sz count flush release
+
+-- Explicitly lambda-lift this function to subvert GHC's full laziness
+-- optimisations, which otherwise tends to float out subexpressions
+-- past the \handle, which is really a pessimisation in this case because
+-- that lambda is a one-shot lambda.
+--
+-- Don't forget to export the function, to stop it being inlined too
+-- (this appears to be better than NOINLINE, because the strictness
+-- analyser still gets to worker-wrapper it).
+--
+-- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
+--
+commitBuffer' hdl raw sz@(I## _) count@(I## _) flush release
+  handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 
 #ifdef DEBUG_DUMP
       puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
@@ -509,7 +527,7 @@ commitBuffer hdl raw sz count flush release = do
                    return (newEmptyBuffer raw WriteBuffer sz)
 
                -- else, we have to flush
-           else do flushed_buf <- flushWriteBuffer fd old_buf
+           else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf
 
                    let this_buf = 
                            Buffer{ bufBuf=raw, bufState=WriteBuffer, 
@@ -527,7 +545,7 @@ commitBuffer hdl raw sz count flush release = do
                        -- otherwise, we have to flush the new data too,
                        -- and start with a fresh buffer
                        else do
-                         flushWriteBuffer fd this_buf
+                         flushWriteBuffer fd (haIsStream handle_) this_buf
                          writeIORef ref flushed_buf
                            -- if the sizes were different, then allocate
                            -- a new buffer of the correct size.
@@ -536,13 +554,15 @@ commitBuffer hdl raw sz count flush release = do
                             else allocateBuffer size WriteBuffer
 
       -- release the buffer if necessary
-      if release && bufSize buf_ret == size
-        then do
+      case buf_ret of
+        Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
+          if release && buf_ret_sz == size
+           then do
              spare_bufs <- readIORef spare_buf_ref
              writeIORef spare_buf_ref 
-               (BufferListCons (bufBuf buf_ret) spare_bufs)
+               (BufferListCons buf_ret_raw spare_bufs)
              return buf_ret
-        else
+           else
              return buf_ret
 
 -- ---------------------------------------------------------------------------
@@ -678,13 +698,13 @@ slurpFile fname = do
 -- ---------------------------------------------------------------------------
 -- memcpy wrappers
 
-foreign import "memcpy_wrap_src_off" unsafe 
+foreign import "__hscore_memcpy_src_off" unsafe 
    memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "memcpy_wrap_src_off" unsafe 
+foreign import "__hscore_memcpy_src_off" unsafe 
    memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "memcpy_wrap_dst_off" unsafe 
+foreign import "__hscore_memcpy_dst_off" unsafe 
    memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import "memcpy_wrap_dst_off" unsafe 
+foreign import "__hscore_memcpy_dst_off" unsafe 
    memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
 
 -----------------------------------------------------------------------------
index 1ff572b..7d94236 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: IOBase.lhs,v 1.4 2001/09/13 15:34:17 simonmar Exp $
+% $Id: IOBase.lhs,v 1.5 2001/12/21 15:07:25 simonmar Exp $
 % 
 % (c) The University of Glasgow, 1994-2001
 %
@@ -9,7 +9,6 @@
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
-#include "config.h"
 
 module GHC.IOBase where
 
@@ -151,13 +150,16 @@ type FD = Int -- XXX ToDo: should be CInt
 
 data Handle__
   = Handle__ {
-      haFD         :: !FD,
-      haType        :: HandleType,
-      haIsBin      :: Bool,
-      haBufferMode  :: BufferMode,
-      haFilePath    :: FilePath,
-      haBuffer     :: !(IORef Buffer),
-      haBuffers     :: !(IORef BufferList)
+      haFD         :: !FD,                  -- file descriptor
+      haType        :: HandleType,          -- type (read/write/append etc.)
+      haIsBin       :: Bool,                -- binary mode?
+      haIsStream    :: Bool,                -- is this a stream handle?
+      haBufferMode  :: BufferMode,          -- buffer contains read/write data?
+      haFilePath    :: FilePath,            -- file name, possibly
+      haBuffer     :: !(IORef Buffer),      -- the current buffer
+      haBuffers     :: !(IORef BufferList),  -- spare buffers
+      haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
+                                            -- duplex handle.
     }
 
 -- ---------------------------------------------------------------------------
@@ -235,11 +237,9 @@ data HandleType
  | WriteHandle
  | AppendHandle
  | ReadWriteHandle
- | ReadSideHandle  !(MVar Handle__)    -- read side of a duplex handle
 
 isReadableHandleType ReadHandle         = True
 isReadableHandleType ReadWriteHandle    = True
-isReadableHandleType (ReadSideHandle _) = True
 isReadableHandleType _                 = False
 
 isWritableHandleType AppendHandle    = True
@@ -326,13 +326,12 @@ instance Show HandleType where
       WriteHandle       -> showString "writable"
       AppendHandle      -> showString "writable (append)"
       ReadWriteHandle   -> showString "read-writable"
-      ReadSideHandle _  -> showString "read-writable (duplex)"
 
 instance Show Handle where 
-  showsPrec p (FileHandle   h)   = showHandle p h
-  showsPrec p (DuplexHandle h _) = showHandle p h
+  showsPrec p (FileHandle   h)   = showHandle p h False
+  showsPrec p (DuplexHandle _ h) = showHandle p h True
    
-showHandle p h =
+showHandle p h duplex =
     let
      -- (Big) SIGH: unfolded defn of takeMVar to avoid
      -- an (oh-so) unfortunate module loop with GHC.Conc.
@@ -341,14 +340,18 @@ showHandle p h =
             case takeMVar# h# s#   of { (# s2# , r #) -> 
             case putMVar# h# r s2# of { s3# ->
             (# s3#, r #) }}})
+
+     showType | duplex = showString "duplex (read-write)"
+             | otherwise = showsPrec p (haType hdl_)
     in
     showChar '{' . 
     showHdl (haType hdl_) 
            (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
-            showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
+            showString "type=" . showType . showChar ',' .
             showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
             showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
    where
+
     showHdl :: HandleType -> ShowS -> ShowS
     showHdl ht cont = 
        case ht of
@@ -522,11 +525,14 @@ data IOErrorType
   | TimeExpired
   | ResourceVanished
   | Interrupted
-#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
-  | ComError Int           -- HRESULT
-#endif
-  deriving (Eq)
-
+  | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
+
+instance Eq IOErrorType where
+   x == y = 
+     case x of
+       DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
+       _ -> getTag# x ==# getTag# y
 instance Show IOErrorType where
   showsPrec _ e =
     showString $
@@ -549,9 +555,7 @@ instance Show IOErrorType where
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
       UnsupportedOperation -> "unsupported operation"
       EOF              -> "end of file"
-#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
-      ComError _       -> "COM error"
-#endif
+      DynIOError{}      -> "unknown IO error"
 
 userError       :: String  -> IOError
 userError str  =  UserError str
index 54e6a5d..d2bf5c2 100644 (file)
@@ -39,17 +39,17 @@ instance Show Int8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
 instance Num Int8 where
-    (I8# x#) + (I8# y#)    = I8# (intToInt8# (x# +# y#))
-    (I8# x#) - (I8# y#)    = I8# (intToInt8# (x# -# y#))
-    (I8# x#) * (I8# y#)    = I8# (intToInt8# (x# *# y#))
-    negate (I8# x#)        = I8# (intToInt8# (negateInt# x#))
+    (I8# x#) + (I8# y#)    = I8# (narrow8Int# (x# +# y#))
+    (I8# x#) - (I8# y#)    = I8# (narrow8Int# (x# -# y#))
+    (I8# x#) * (I8# y#)    = I8# (narrow8Int# (x# *# y#))
+    negate (I8# x#)        = I8# (narrow8Int# (negateInt# x#))
     abs x | x >= 0         = x
           | otherwise      = negate x
     signum x | x > 0       = 1
     signum 0               = 0
     signum _               = -1
-    fromInteger (S# i#)    = I8# (intToInt8# i#)
-    fromInteger (J# s# d#) = I8# (intToInt8# (integer2Int# s# d#))
+    fromInteger (S# i#)    = I8# (narrow8Int# i#)
+    fromInteger (J# s# d#) = I8# (narrow8Int# (integer2Int# s# d#))
 
 instance Real Int8 where
     toRational x = toInteger x % 1
@@ -71,24 +71,24 @@ instance Enum Int8 where
 
 instance Integral Int8 where
     quot    x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = I8# (intToInt8# (x# `quotInt#` y#))
+        | y /= 0                  = I8# (narrow8Int# (x# `quotInt#` y#))
         | otherwise               = divZeroError "quot{Int8}" x
     rem     x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = I8# (intToInt8# (x# `remInt#` y#))
+        | y /= 0                  = I8# (narrow8Int# (x# `remInt#` y#))
         | otherwise               = divZeroError "rem{Int8}" x
     div     x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = I8# (intToInt8# (x# `divInt#` y#))
+        | y /= 0                  = I8# (narrow8Int# (x# `divInt#` y#))
         | otherwise               = divZeroError "div{Int8}" x
     mod     x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = I8# (intToInt8# (x# `modInt#` y#))
+        | y /= 0                  = I8# (narrow8Int# (x# `modInt#` y#))
         | otherwise               = divZeroError "mod{Int8}" x
     quotRem x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = (I8# (intToInt8# (x# `quotInt#` y#)),
-                                    I8# (intToInt8# (x# `remInt#` y#)))
+        | y /= 0                  = (I8# (narrow8Int# (x# `quotInt#` y#)),
+                                    I8# (narrow8Int# (x# `remInt#` y#)))
         | otherwise               = divZeroError "quotRem{Int8}" x
     divMod  x@(I8# x#) y@(I8# y#)
-        | y /= 0                  = (I8# (intToInt8# (x# `divInt#` y#)),
-                                    I8# (intToInt8# (x# `modInt#` y#)))
+        | y /= 0                  = (I8# (narrow8Int# (x# `divInt#` y#)),
+                                    I8# (narrow8Int# (x# `modInt#` y#)))
         | otherwise               = divZeroError "divMod{Int8}" x
     toInteger (I8# x#)            = S# x#
 
@@ -97,11 +97,10 @@ instance Bounded Int8 where
     maxBound =  0x7F
 
 instance Ix Int8 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Int8"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Int8 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -112,20 +111,23 @@ instance Bits Int8 where
     (I8# x#) `xor` (I8# y#)   = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
     complement (I8# x#)       = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
     (I8# x#) `shift` (I# i#)
-        | i# >=# 0#           = I8# (intToInt8# (x# `iShiftL#` i#))
+        | i# >=# 0#           = I8# (narrow8Int# (x# `iShiftL#` i#))
         | otherwise           = I8# (x# `iShiftRA#` negateInt# i#)
-    (I8# x#) `rotate` (I# i#) =
-        I8# (intToInt8# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                                    (x'# `shiftRL#` (8# -# i'#)))))
+    (I8# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I8# x#
+        | otherwise
+        = I8# (narrow8Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
+                                       (x'# `shiftRL#` (8# -# i'#)))))
         where
-        x'# = wordToWord8# (int2Word# x#)
+        x'# = narrow8Word# (int2Word# x#)
         i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
     bitSize  _                = 8
     isSigned _                = True
 
 {-# RULES
 "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
-"fromIntegral/a->Int8"    fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (intToInt8# x#)
+"fromIntegral/a->Int8"    fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
 "fromIntegral/Int8->a"    fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
   #-}
 
@@ -145,17 +147,17 @@ instance Show Int16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
 instance Num Int16 where
-    (I16# x#) + (I16# y#)  = I16# (intToInt16# (x# +# y#))
-    (I16# x#) - (I16# y#)  = I16# (intToInt16# (x# -# y#))
-    (I16# x#) * (I16# y#)  = I16# (intToInt16# (x# *# y#))
-    negate (I16# x#)       = I16# (intToInt16# (negateInt# x#))
+    (I16# x#) + (I16# y#)  = I16# (narrow16Int# (x# +# y#))
+    (I16# x#) - (I16# y#)  = I16# (narrow16Int# (x# -# y#))
+    (I16# x#) * (I16# y#)  = I16# (narrow16Int# (x# *# y#))
+    negate (I16# x#)       = I16# (narrow16Int# (negateInt# x#))
     abs x | x >= 0         = x
           | otherwise      = negate x
     signum x | x > 0       = 1
     signum 0               = 0
     signum _               = -1
-    fromInteger (S# i#)    = I16# (intToInt16# i#)
-    fromInteger (J# s# d#) = I16# (intToInt16# (integer2Int# s# d#))
+    fromInteger (S# i#)    = I16# (narrow16Int# i#)
+    fromInteger (J# s# d#) = I16# (narrow16Int# (integer2Int# s# d#))
 
 instance Real Int16 where
     toRational x = toInteger x % 1
@@ -177,24 +179,24 @@ instance Enum Int16 where
 
 instance Integral Int16 where
     quot    x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = I16# (intToInt16# (x# `quotInt#` y#))
+        | y /= 0                  = I16# (narrow16Int# (x# `quotInt#` y#))
         | otherwise               = divZeroError "quot{Int16}" x
     rem     x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = I16# (intToInt16# (x# `remInt#` y#))
+        | y /= 0                  = I16# (narrow16Int# (x# `remInt#` y#))
         | otherwise               = divZeroError "rem{Int16}" x
     div     x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = I16# (intToInt16# (x# `divInt#` y#))
+        | y /= 0                  = I16# (narrow16Int# (x# `divInt#` y#))
         | otherwise               = divZeroError "div{Int16}" x
     mod     x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = I16# (intToInt16# (x# `modInt#` y#))
+        | y /= 0                  = I16# (narrow16Int# (x# `modInt#` y#))
         | otherwise               = divZeroError "mod{Int16}" x
     quotRem x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = (I16# (intToInt16# (x# `quotInt#` y#)),
-                                    I16# (intToInt16# (x# `remInt#` y#)))
+        | y /= 0                  = (I16# (narrow16Int# (x# `quotInt#` y#)),
+                                    I16# (narrow16Int# (x# `remInt#` y#)))
         | otherwise               = divZeroError "quotRem{Int16}" x
     divMod  x@(I16# x#) y@(I16# y#)
-        | y /= 0                  = (I16# (intToInt16# (x# `divInt#` y#)),
-                                    I16# (intToInt16# (x# `modInt#` y#)))
+        | y /= 0                  = (I16# (narrow16Int# (x# `divInt#` y#)),
+                                    I16# (narrow16Int# (x# `modInt#` y#)))
         | otherwise               = divZeroError "divMod{Int16}" x
     toInteger (I16# x#)           = S# x#
 
@@ -203,11 +205,10 @@ instance Bounded Int16 where
     maxBound =  0x7FFF
 
 instance Ix Int16 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Int16"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Int16 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -218,13 +219,16 @@ instance Bits Int16 where
     (I16# x#) `xor` (I16# y#)  = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
     complement (I16# x#)       = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
     (I16# x#) `shift` (I# i#)
-        | i# >=# 0#            = I16# (intToInt16# (x# `iShiftL#` i#))
+        | i# >=# 0#            = I16# (narrow16Int# (x# `iShiftL#` i#))
         | otherwise            = I16# (x# `iShiftRA#` negateInt# i#)
-    (I16# x#) `rotate` (I# i#) =
-        I16# (intToInt16# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                                      (x'# `shiftRL#` (16# -# i'#)))))
+    (I16# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I16# x#
+        | otherwise
+        = I16# (narrow16Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
+                                         (x'# `shiftRL#` (16# -# i'#)))))
         where
-        x'# = wordToWord16# (int2Word# x#)
+        x'# = narrow16Word# (int2Word# x#)
         i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
     bitSize  _                 = 16
     isSigned _                 = True
@@ -233,7 +237,7 @@ instance Bits Int16 where
 "fromIntegral/Word8->Int16"  fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
 "fromIntegral/Int8->Int16"   fromIntegral = \(I8# x#) -> I16# x#
 "fromIntegral/Int16->Int16"  fromIntegral = id :: Int16 -> Int16
-"fromIntegral/a->Int16"      fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (intToInt16# x#)
+"fromIntegral/a->Int16"      fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
 "fromIntegral/Int16->a"      fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
   #-}
 
@@ -241,35 +245,176 @@ instance Bits Int16 where
 -- type Int32
 ------------------------------------------------------------------------
 
+#if WORD_SIZE_IN_BITS < 32
+
+data Int32 = I32# Int32#
+
+instance Eq Int32 where
+    (I32# x#) == (I32# y#) = x# `eqInt32#` y#
+    (I32# x#) /= (I32# y#) = x# `neInt32#` y#
+
+instance Ord Int32 where
+    (I32# x#) <  (I32# y#) = x# `ltInt32#` y#
+    (I32# x#) <= (I32# y#) = x# `leInt32#` y#
+    (I32# x#) >  (I32# y#) = x# `gtInt32#` y#
+    (I32# x#) >= (I32# y#) = x# `geInt32#` y#
+
+instance Show Int32 where
+    showsPrec p x = showsPrec p (toInteger x)
+
+instance Num Int32 where
+    (I32# x#) + (I32# y#)  = I32# (x# `plusInt32#`  y#)
+    (I32# x#) - (I32# y#)  = I32# (x# `minusInt32#` y#)
+    (I32# x#) * (I32# y#)  = I32# (x# `timesInt32#` y#)
+    negate (I32# x#)       = I32# (negateInt32# x#)
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger (S# i#)    = I32# (intToInt32# i#)
+    fromInteger (J# s# d#) = I32# (integerToInt32# s# d#)
+
+instance Enum Int32 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int32"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int32"
+    toEnum (I# i#)      = I32# (intToInt32# i#)
+    fromEnum x@(I32# x#)
+        | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+                        = I# (int32ToInt# x#)
+        | otherwise     = fromEnumError "Int32" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+
+instance Integral Int32 where
+    quot    x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = I32# (x# `quotInt32#` y#)
+        | otherwise               = divZeroError "quot{Int32}" x
+    rem     x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = I32# (x# `remInt32#` y#)
+        | otherwise               = divZeroError "rem{Int32}" x
+    div     x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = I32# (x# `divInt32#` y#)
+        | otherwise               = divZeroError "div{Int32}" x
+    mod     x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = I32# (x# `modInt32#` y#)
+        | otherwise               = divZeroError "mod{Int32}" x
+    quotRem x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = (I32# (x# `quotInt32#` y#), I32# (x# `remInt32#` y#))
+        | otherwise               = divZeroError "quotRem{Int32}" x
+    divMod  x@(I32# x#) y@(I32# y#)
+        | y /= 0                  = (I32# (x# `divInt32#` y#), I32# (x# `modInt32#` y#))
+        | otherwise               = divZeroError "divMod{Int32}" x
+    toInteger x@(I32# x#)
+       | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+                                  = S# (int32ToInt# x#)
+        | otherwise               = case int32ToInteger# x# of (# s, d #) -> J# s d
+
+divInt32#, modInt32# :: Int32# -> Int32# -> Int32#
+x# `divInt32#` y#
+    | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#)
+        = ((x# `minusInt32#` y#) `minusInt32#` intToInt32# 1#) `quotInt32#` y#
+    | (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#)
+        = ((x# `minusInt32#` y#) `plusInt32#` intToInt32# 1#) `quotInt32#` y#
+    | otherwise                = x# `quotInt32#` y#
+x# `modInt32#` y#
+    | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#) ||
+      (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#)
+        = if r# `neInt32#` intToInt32# 0# then r# `plusInt32#` y# else intToInt32# 0#
+    | otherwise = r#
+    where
+    r# = x# `remInt32#` y#
+
+instance Read Int32 where
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+instance Bits Int32 where
+    (I32# x#) .&.   (I32# y#)  = I32# (word32ToInt32# (int32ToWord32# x# `and32#` int32ToWord32# y#))
+    (I32# x#) .|.   (I32# y#)  = I32# (word32ToInt32# (int32ToWord32# x# `or32#`  int32ToWord32# y#))
+    (I32# x#) `xor` (I32# y#)  = I32# (word32ToInt32# (int32ToWord32# x# `xor32#` int32ToWord32# y#))
+    complement (I32# x#)       = I32# (word32ToInt32# (not32# (int32ToWord32# x#)))
+    (I32# x#) `shift` (I# i#)
+        | i# >=# 0#            = I32# (x# `iShiftL32#` i#)
+        | otherwise            = I32# (x# `iShiftRA32#` negateInt# i#)
+    (I32# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I32# x#
+        | otherwise
+        = I32# (word32ToInt32# ((x'# `shiftL32#` i'#) `or32#`
+                                (x'# `shiftRL32#` (32# -# i'#))))
+        where
+        x'# = int32ToWord32# x#
+        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+    bitSize  _                 = 32
+    isSigned _                 = True
+
+foreign import "stg_eqInt32"       unsafe eqInt32#       :: Int32# -> Int32# -> Bool
+foreign import "stg_neInt32"       unsafe neInt32#       :: Int32# -> Int32# -> Bool
+foreign import "stg_ltInt32"       unsafe ltInt32#       :: Int32# -> Int32# -> Bool
+foreign import "stg_leInt32"       unsafe leInt32#       :: Int32# -> Int32# -> Bool
+foreign import "stg_gtInt32"       unsafe gtInt32#       :: Int32# -> Int32# -> Bool
+foreign import "stg_geInt32"       unsafe geInt32#       :: Int32# -> Int32# -> Bool
+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_quotInt32"     unsafe quotInt32#     :: Int32# -> Int32# -> Int32#
+foreign import "stg_remInt32"      unsafe remInt32#      :: Int32# -> Int32# -> Int32#
+foreign import "stg_intToInt32"    unsafe intToInt32#    :: Int# -> Int32#
+foreign import "stg_int32ToInt"    unsafe int32ToInt#    :: Int32# -> Int#
+foreign import "stg_wordToWord32"  unsafe wordToWord32#  :: Word# -> Word32#
+foreign import "stg_int32ToWord32" unsafe int32ToWord32# :: Int32# -> Word32#
+foreign import "stg_word32ToInt32" unsafe word32ToInt32# :: Word32# -> Int32#
+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_iShiftL32"     unsafe iShiftL32#     :: Int32# -> Int# -> Int32#
+foreign import "stg_iShiftRA32"    unsafe iShiftRA32#    :: Int32# -> Int# -> Int32#
+foreign import "stg_shiftL32"      unsafe shiftL32#      :: Word32# -> Int# -> Word32#
+foreign import "stg_shiftRL32"     unsafe shiftRL32#     :: Word32# -> Int# -> Word32#
+
+{-# RULES
+"fromIntegral/Int->Int32"    fromIntegral = \(I#   x#) -> I32# (intToInt32# x#)
+"fromIntegral/Word->Int32"   fromIntegral = \(W#   x#) -> I32# (word32ToInt32# (wordToWord32# x#))
+"fromIntegral/Word32->Int32" fromIntegral = \(W32# x#) -> I32# (word32ToInt32# x#)
+"fromIntegral/Int32->Int"    fromIntegral = \(I32# x#) -> I#   (int32ToInt# x#)
+"fromIntegral/Int32->Word"   fromIntegral = \(I32# x#) -> W#   (int2Word# (int32ToInt# x#))
+"fromIntegral/Int32->Word32" fromIntegral = \(I32# x#) -> W32# (int32ToWord32# x#)
+"fromIntegral/Int32->Int32"  fromIntegral = id :: Int32 -> Int32
+  #-}
+
+#else 
+
 -- Int32 is represented in the same way as Int.
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
 -- Operations may assume and must ensure that it holds only values
 -- from its logical range.
 #endif
 
 data Int32 = I32# Int# deriving (Eq, Ord)
 
-instance CCallable Int32
-instance CReturnable Int32
-
 instance Show Int32 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
 instance Num Int32 where
-    (I32# x#) + (I32# y#)  = I32# (intToInt32# (x# +# y#))
-    (I32# x#) - (I32# y#)  = I32# (intToInt32# (x# -# y#))
-    (I32# x#) * (I32# y#)  = I32# (intToInt32# (x# *# y#))
-    negate (I32# x#)       = I32# (intToInt32# (negateInt# x#))
+    (I32# x#) + (I32# y#)  = I32# (narrow32Int# (x# +# y#))
+    (I32# x#) - (I32# y#)  = I32# (narrow32Int# (x# -# y#))
+    (I32# x#) * (I32# y#)  = I32# (narrow32Int# (x# *# y#))
+    negate (I32# x#)       = I32# (narrow32Int# (negateInt# x#))
     abs x | x >= 0         = x
           | otherwise      = negate x
     signum x | x > 0       = 1
     signum 0               = 0
     signum _               = -1
-    fromInteger (S# i#)    = I32# (intToInt32# i#)
-    fromInteger (J# s# d#) = I32# (intToInt32# (integer2Int# s# d#))
-
-instance Real Int32 where
-    toRational x = toInteger x % 1
+    fromInteger (S# i#)    = I32# (narrow32Int# i#)
+    fromInteger (J# s# d#) = I32# (narrow32Int# (integer2Int# s# d#))
 
 instance Enum Int32 where
     succ x
@@ -278,7 +423,7 @@ instance Enum Int32 where
     pred x
         | x /= minBound = x - 1
         | otherwise     = predError "Int32"
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
     toEnum (I# i#)      = I32# i#
 #else
     toEnum i@(I# i#)
@@ -292,38 +437,27 @@ instance Enum Int32 where
 
 instance Integral Int32 where
     quot    x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = I32# (intToInt32# (x# `quotInt#` y#))
+        | y /= 0                  = I32# (narrow32Int# (x# `quotInt#` y#))
         | otherwise               = divZeroError "quot{Int32}" x
     rem     x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = I32# (intToInt32# (x# `remInt#` y#))
+        | y /= 0                  = I32# (narrow32Int# (x# `remInt#` y#))
         | otherwise               = divZeroError "rem{Int32}" x
     div     x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = I32# (intToInt32# (x# `divInt#` y#))
+        | y /= 0                  = I32# (narrow32Int# (x# `divInt#` y#))
         | otherwise               = divZeroError "div{Int32}" x
     mod     x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = I32# (intToInt32# (x# `modInt#` y#))
+        | y /= 0                  = I32# (narrow32Int# (x# `modInt#` y#))
         | otherwise               = divZeroError "mod{Int32}" x
     quotRem x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = (I32# (intToInt32# (x# `quotInt#` y#)),
-                                    I32# (intToInt32# (x# `remInt#` y#)))
+        | y /= 0                  = (I32# (narrow32Int# (x# `quotInt#` y#)),
+                                    I32# (narrow32Int# (x# `remInt#` y#)))
         | otherwise               = divZeroError "quotRem{Int32}" x
     divMod  x@(I32# x#) y@(I32# y#)
-        | y /= 0                  = (I32# (intToInt32# (x# `divInt#` y#)),
-                                    I32# (intToInt32# (x# `modInt#` y#)))
+        | y /= 0                  = (I32# (narrow32Int# (x# `divInt#` y#)),
+                                    I32# (narrow32Int# (x# `modInt#` y#)))
         | otherwise               = divZeroError "divMod{Int32}" x
     toInteger (I32# x#)           = S# x#
 
-instance Bounded Int32 where
-    minBound = -0x80000000
-    maxBound =  0x7FFFFFFF
-
-instance Ix Int32 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Int32"
-    inRange (m,n) i   = m <= i && i <= n
-
 instance Read Int32 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
 
@@ -333,13 +467,16 @@ instance Bits Int32 where
     (I32# x#) `xor` (I32# y#)  = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
     complement (I32# x#)       = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
     (I32# x#) `shift` (I# i#)
-        | i# >=# 0#            = I32# (intToInt32# (x# `iShiftL#` i#))
+        | i# >=# 0#            = I32# (narrow32Int# (x# `iShiftL#` i#))
         | otherwise            = I32# (x# `iShiftRA#` negateInt# i#)
-    (I32# x#) `rotate` (I# i#) =
-        I32# (intToInt32# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                                      (x'# `shiftRL#` (32# -# i'#)))))
+    (I32# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I32# x#
+        | otherwise
+        = I32# (narrow32Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
+                                        (x'# `shiftRL#` (32# -# i'#)))))
         where
-        x'# = wordToWord32# (int2Word# x#)
+        x'# = narrow32Word# (int2Word# x#)
         i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
     bitSize  _                 = 32
     isSigned _                 = True
@@ -350,15 +487,33 @@ instance Bits Int32 where
 "fromIntegral/Int8->Int32"   fromIntegral = \(I8# x#) -> I32# x#
 "fromIntegral/Int16->Int32"  fromIntegral = \(I16# x#) -> I32# x#
 "fromIntegral/Int32->Int32"  fromIntegral = id :: Int32 -> Int32
-"fromIntegral/a->Int32"      fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (intToInt32# x#)
+"fromIntegral/a->Int32"      fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
 "fromIntegral/Int32->a"      fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
   #-}
 
+#endif 
+
+instance CCallable Int32
+instance CReturnable Int32
+
+instance Real Int32 where
+    toRational x = toInteger x % 1
+
+instance Bounded Int32 where
+    minBound = -0x80000000
+    maxBound =  0x7FFFFFFF
+
+instance Ix Int32 where
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
 ------------------------------------------------------------------------
 -- type Int64
 ------------------------------------------------------------------------
 
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS < 64
 
 data Int64 = I64# Int64#
 
@@ -425,10 +580,11 @@ instance Integral Int64 where
         | y /= 0                  = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#))
         | otherwise               = divZeroError "divMod{Int64}" x
     toInteger x@(I64# x#)
-        | x >= -0x80000000 && x <= 0x7FFFFFFF
+       | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
                                   = S# (int64ToInt# x#)
         | otherwise               = case int64ToInteger# x# of (# s, d #) -> J# s d
 
+
 divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
 x# `divInt64#` y#
     | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#)
@@ -455,9 +611,12 @@ instance Bits Int64 where
     (I64# x#) `shift` (I# i#)
         | i# >=# 0#            = I64# (x# `iShiftL64#` i#)
         | otherwise            = I64# (x# `iShiftRA64#` negateInt# i#)
-    (I64# x#) `rotate` (I# i#) =
-        I64# (word64ToInt64# ((x'# `shiftL64#` i'#) `or64#`
-                              (x'# `shiftRL64#` (64# -# i'#))))
+    (I64# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I64# x#
+        | otherwise
+        = I64# (word64ToInt64# ((x'# `shiftL64#` i'#) `or64#`
+                                (x'# `shiftRL64#` (64# -# i'#))))
         where
         x'# = int64ToWord64# x#
         i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
@@ -490,6 +649,8 @@ foreign import "stg_iShiftRA64"    unsafe iShiftRA64#    :: Int64# -> Int# -> In
 foreign import "stg_shiftL64"      unsafe shiftL64#      :: Word64# -> Int# -> Word64#
 foreign import "stg_shiftRL64"     unsafe shiftRL64#     :: Word64# -> Int# -> Word64#
 
+foreign import "stg_integerToInt64"  unsafe integerToInt64#  :: Int# -> ByteArray# -> Int64#
+
 {-# RULES
 "fromIntegral/Int->Int64"    fromIntegral = \(I#   x#) -> I64# (intToInt64# x#)
 "fromIntegral/Word->Int64"   fromIntegral = \(W#   x#) -> I64# (word64ToInt64# (wordToWord64# x#))
@@ -500,7 +661,11 @@ foreign import "stg_shiftRL64"     unsafe shiftRL64#     :: Word64# -> Int# -> W
 "fromIntegral/Int64->Int64"  fromIntegral = id :: Int64 -> Int64
   #-}
 
-#else
+#else 
+
+-- Int64 is represented in the same way as Int.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
 
 data Int64 = I64# Int# deriving (Eq, Ord)
 
@@ -564,9 +729,12 @@ instance Bits Int64 where
     (I64# x#) `shift` (I# i#)
         | i# >=# 0#            = I64# (x# `iShiftL#` i#)
         | otherwise            = I64# (x# `iShiftRA#` negateInt# i#)
-    (I64# x#) `rotate` (I# i#) =
-        I64# (word2Int# ((x'# `shiftL#` i'#) `or#`
-                         (x'# `shiftRL#` (64# -# i'#))))
+    (I64# x#) `rotate` (I# i#)
+        | i'# ==# 0# 
+        = I64# x#
+        | otherwise
+        = I64# (word2Int# ((x'# `shiftL#` i'#) `or#`
+                           (x'# `shiftRL#` (64# -# i'#))))
         where
         x'# = int2Word# x#
         i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
@@ -591,9 +759,8 @@ instance Bounded Int64 where
     maxBound =  0x7FFFFFFFFFFFFFFF
 
 instance Ix Int64 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Int64"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 \end{code}
index 5c887ec..b7f4beb 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: List.lhs,v 1.4 2001/07/31 13:14:01 simonmar Exp $
+% $Id: List.lhs,v 1.5 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -118,9 +118,11 @@ 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
 
+{-# INLINE [0] filter #-}
 filterFB c p x r | p x       = x `c` r
                 | otherwise = r
 
@@ -176,9 +178,9 @@ scanl f q ls            =  q : (case ls of
                                 []   -> []
                                 x:xs -> scanl f (f q x) xs)
 
-scanl1                  :: (a -> a -> a) -> [a] -> [a]
-scanl1 f (x:xs)         =  scanl f x xs
-scanl1 _ []             =  errorEmptyList "scanl1"
+scanl1                 :: (a -> a -> a) -> [a] -> [a]
+scanl1 f (x:xs)                =  scanl f x xs
+scanl1 _ []            =  []
 
 -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
 -- above functions.
@@ -194,14 +196,15 @@ scanr f q0 (x:xs)       =  f x q : qs
                            where qs@(q:_) = scanr f q0 xs 
 
 scanr1                  :: (a -> a -> a) -> [a] -> [a]
-scanr1 _  [x]           =  [x]
-scanr1 f  (x:xs)        =  f x q : qs
+scanr1 f []            =  []
+scanr1 f [x]           =  [x]
+scanr1 f (x:xs)                =  f x q : qs
                            where qs@(q:_) = scanr1 f xs 
-scanr1 _ []             =  errorEmptyList "scanr1"
 
 -- 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
 
 iterateFB c f x = x `c` iterateFB c f (f x)
@@ -216,9 +219,12 @@ iterateList f x =  x : iterateList f (f x)
 
 -- repeat x is an infinite list, with x the value of every element.
 repeat :: a -> [a]
+{-# NOINLINE [1] repeat #-}
 repeat = repeatList
 
+{-# INLINE [0] repeatFB #-}
 repeatFB c x = xs where xs = x `c` xs
+
 repeatList x = xs where xs = x :   xs
 
 {-# RULES
@@ -447,10 +453,10 @@ concat = foldr (++) []
 -- List index (subscript) operator, 0-origin
 (!!)                    :: [a] -> Int -> a
 #ifdef USE_REPORT_PRELUDE
-(x:_)  !! 0             =  x
-(_:xs) !! n | n > 0     =  xs !! (minusInt n 1)
-(_:_)  !! _             =  error "Prelude.(!!): negative index"
-[]     !! _             =  error "Prelude.(!!): index too large"
+xs     !! n | n < 0 =  error "Prelude.!!: negative index"
+[]     !! _         =  error "Prelude.!!: index too large"
+(x:_)  !! 0         =  x
+(_:xs) !! n         =  xs !! (n-1)
 #else
 -- HBC version (stolen), then unboxified
 -- The semantics is not quite the same for error conditions
@@ -514,8 +520,10 @@ tuples are in the List module.
 \begin{code}
 ----------------------------------------------
 zip :: [a] -> [b] -> [(a,b)]
+{-# NOINLINE [1] zip #-}
 zip = zipList
 
+{-# INLINE [0] zipFB #-}
 zipFB c x y r = (x,y) `c` r
 
 
@@ -548,9 +556,10 @@ zip3 _      _      _      = []
 \begin{code}
 ----------------------------------------------
 zipWith :: (a->b->c) -> [a]->[b]->[c]
+{-# NOINLINE [1] zipWith #-}
 zipWith = zipWithList
 
-
+{-# INLINE [0] zipWithFB #-}
 zipWithFB c f x y r = (x `f` y) `c` r
 
 zipWithList                 :: (a->b->c) -> [a] -> [b] -> [c]
index 611236c..8bc005b 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Num.lhs,v 1.2 2001/07/31 13:09:11 simonmar Exp $
+% $Id: Num.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -19,12 +19,12 @@ and the type
 {-# OPTIONS -fno-implicit-prelude #-}
 
 #include "MachDeps.h"
-#if WORD_SIZE_IN_BYTES == 4
+#if SIZEOF_HSWORD == 4
 #define LEFTMOST_BIT 2147483648
-#elif WORD_SIZE_IN_BYTES == 8
+#elif SIZEOF_HSWORD == 8
 #define LEFTMOST_BIT 9223372036854775808
 #else
-#error Please define LEFTMOST_BIT to be 2^(WORD_SIZE_IN_BYTES*8-1)
+#error Please define LEFTMOST_BIT to be 2^(SIZEOF_HSWORD*8-1)
 #endif
 
 module GHC.Num where
@@ -109,7 +109,13 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
 \begin{code}
 data Integer   
    = S# Int#                           -- small integers
+#ifndef ILX
    | J# Int# ByteArray#                        -- large integers
+#else
+   | J# Void BigInteger                 -- .NET big ints
+
+foreign type dotnet "BigInteger" BigInteger
+#endif
 \end{code}
 
 Convenient boxed Integer PrimOps. 
@@ -346,9 +352,9 @@ minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2
 minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2
 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 
-timesInteger i1@(S# i) i2@(S# j)   = case mulIntC# i j of { (# r, c #) ->
-                                    if c ==# 0# then S# r
-                                    else toBig i1 * toBig i2 }
+timesInteger i1@(S# i) i2@(S# j)   = if   mulIntMayOflo# i j ==# 0#
+                                     then S# (i *# j)
+                                     else toBig i1 * toBig i2 
 timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
 timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
@@ -436,7 +442,10 @@ dn_list x delta lim = go (x::Integer)
 \begin{code}
 instance Show Integer where
     showsPrec p n r
-        | n < 0 && p > 6 = '(' : jtos n (')' : r)
+        | p > 6 && n < 0 = '(' : jtos n (')' : r)
+               -- Minor point: testing p first gives better code 
+               -- in the not-uncommon case where the p argument
+               -- is a constant
         | otherwise      = jtos n r
     showList = showList__ (showsPrec 0)
 
index 819beea..339f9bb 100644 (file)
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-implicit-prelude #-}
 
 -- ---------------------------------------------------------------------------
--- $Id: Posix.hsc,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: Posix.hsc,v 1.4 2001/12/21 15:07:25 simonmar Exp $
 --
 -- POSIX support layer for the standard libraries
 --
@@ -90,6 +90,8 @@ fileType file =
       c_stat p_file p_stat
     statGetType p_stat
 
+-- NOTE: On Win32 platforms, this will only work with file descriptors
+-- 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
@@ -121,6 +123,16 @@ fileTruncate file = do
     c_close fd
   return ()
 
+#ifdef mingw32_TARGET_OS
+closeFd :: Bool -> CInt -> IO CInt
+closeFd isStream fd 
+  | isStream  = c_closesocket fd
+  | otherwise = c_close fd
+
+foreign import "closesocket" unsafe
+   c_closesocket :: CInt -> IO CInt
+#endif
+
 -- ---------------------------------------------------------------------------
 -- Terminal-related stuff
 
@@ -209,9 +221,11 @@ getEcho fd = return False
 setNonBlockingFD fd = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
                 (c_fcntl_read (fromIntegral fd) (#const F_GETFL))
-  throwErrnoIfMinus1Retry "setNonBlockingFD"
-       (c_fcntl_write (fromIntegral fd) 
-          (#const F_SETFL) (flags .|. #const O_NONBLOCK))
+  -- 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.
+  fcntl_write (fromIntegral fd) 
+       (#const F_SETFL) (flags .|. #const O_NONBLOCK)
 #else
 
 -- bogus defns for win32
@@ -355,7 +369,7 @@ foreign import ccall "fcntl" unsafe
 foreign import ccall "fork" unsafe
    c_fork :: IO CPid 
 
-foreign import ccall "sigemptyset" unsafe
+foreign import ccall "sigemptyset_wrap" unsafe
    c_sigemptyset :: Ptr CSigset -> IO ()
 
 foreign import ccall "sigaddset" unsafe
similarity index 88%
rename from GHC/Prim.hi-boot
rename to GHC/Prim.hi-boot.pp
index 2b7d8bb..84d7edc 100644 (file)
@@ -1,10 +1,12 @@
 ---------------------------------------------------------------------------
---                             PrelGHC.hi-boot
+--                             GHC/Prim.hi-boot
 -- 
 --     This hand-written interface file allows you to bring into scope the 
 --     primitive operations and types that GHC knows about.
 ---------------------------------------------------------------------------
 
+#include "MachDeps.h"
+
 __interface "core" GHCziPrim 1 0 where
 
 __export GHCziPrim
@@ -49,6 +51,9 @@ __export GHCziPrim
   tryPutMVarzh
   isEmptyMVarzh
 
+  -- Seq
+  seq          -- Defined in MkId
+
   -- Parallel
   seqzh
   parzh
@@ -85,12 +90,12 @@ __export GHCziPrim
   remIntzh
   gcdIntzh
   negateIntzh
-  iShiftLzh
-  iShiftRAzh
-  iShiftRLzh
+  uncheckedIShiftLzh
+  uncheckedIShiftRAzh
+  uncheckedIShiftRLzh
   addIntCzh
   subIntCzh
-  mulIntCzh
+  mulIntMayOflozh
 
   Wordzh
   gtWordzh
@@ -108,30 +113,43 @@ __export GHCziPrim
   orzh
   notzh
   xorzh
-  shiftLzh
-  shiftRLzh
+  uncheckedShiftLzh
+  uncheckedShiftRLzh
   int2Wordzh
   word2Intzh
 
+  narrow8Intzh
+  narrow16Intzh
+  narrow32Intzh
+  narrow8Wordzh
+  narrow16Wordzh
+  narrow32Wordzh
+
+#if WORD_SIZE_IN_BITS < 32
+  Int32zh
+  Word32zh
+#endif
+
+#if WORD_SIZE_IN_BITS < 64
   Int64zh
   Word64zh
-
-  intToInt8zh
-  intToInt16zh
-  intToInt32zh
-  wordToWord8zh
-  wordToWord16zh
-  wordToWord32zh
+#endif
 
   Addrzh
+  nullAddrzh   -- Defined in MkId
+  plusAddrzh
+  minusAddrzh
+  remAddrzh
+#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
+  addr2Intzh
+  int2Addrzh
+#endif
   gtAddrzh
   geAddrzh
   eqAddrzh
   neAddrzh
   ltAddrzh
   leAddrzh
-  int2Addrzh
-  addr2Intzh
 
   Floatzh
   gtFloatzh
@@ -193,6 +211,9 @@ __export GHCziPrim
   ztztzhzh
   decodeDoublezh
 
+-- Integer is implemented by foreign imports on .NET, so no primops
+
+#ifndef ILX
   cmpIntegerzh
   cmpIntegerIntzh
   plusIntegerzh
@@ -210,14 +231,21 @@ __export GHCziPrim
   integer2Wordzh
   int2Integerzh
   word2Integerzh
-  integerToInt64zh
-  integerToWord64zh
+#if WORD_SIZE_IN_BITS < 32
+  integerToInt32zh
+  integerToWord32zh
+  int32ToIntegerzh
+  word32ToIntegerzh
+#endif  
+#if WORD_SIZE_IN_BITS < 64
   int64ToIntegerzh
   word64ToIntegerzh
+#endif
   andIntegerzh
   orIntegerzh
   xorIntegerzh
   complementIntegerzh
+#endif
 
   Arrayzh
   ByteArrayzh
@@ -392,19 +420,19 @@ __export GHCziPrim
   eqStableNamezh
   stableNameToIntzh
 
-  reallyUnsafePtrEqualityzh
-
   newBCOzh
   BCOzh
   mkApUpd0zh
 
-  unsafeCoercezh
+  unsafeCoercezh       -- unsafeCoerce# :: forall a b. a -> b
+                       -- It's defined in ghc/compiler/basicTypes/MkId.lhs
   addrToHValuezh
 ;
 
--- Export GHC.Err.error, so that others don't have to import PrelErr
+-- Export GHC.Err.error, so that others do not have to import PrelErr
 __export GHCziErr error ;
 
+infixr 0 seq ;
 
 --------------------------------------------------
 instance {CCallable Charzh} = zdfCCallableCharzh;
@@ -426,7 +454,7 @@ instance __forall s => {CCallable (StablePtrzh s)} = zdfCCallableStablePtrzh;
 
 1 assert :: __forall a => GHCziBase.Bool -> a -> a ;
 
--- These guys don't really exist:
+-- These guys do not really exist:
 --
 1 zdfCCallableCharzh :: {CCallable Charzh} ;
 1 zdfCCallableDoublezh :: {CCallable Doublezh} ;
@@ -440,3 +468,4 @@ instance __forall s => {CCallable (StablePtrzh s)} = zdfCCallableStablePtrzh;
 1 zdfCCallableMutableByteArrayzh :: __forall s => {CCallable (MutableByteArrayzh s)} ;
 1 zdfCCallableForeignObjzh :: {CCallable ForeignObjzh} ;
 1 zdfCCallableStablePtrzh :: __forall a => {CCallable (StablePtrzh a)} ;
+
index 61b7f3e..dc6186a 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Ptr.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+-- $Id: Ptr.lhs,v 1.2 2001/12/21 15:07:25 simonmar Exp $
 -- 
 -- (c) The FFI Task Force, 2000
 -- 
@@ -17,23 +17,22 @@ import GHC.Base
 data Ptr a = Ptr Addr# deriving (Eq, Ord)
 
 nullPtr :: Ptr a
-nullPtr = Ptr (int2Addr# 0#)
+nullPtr = Ptr nullAddr#
 
 castPtr :: Ptr a -> Ptr b
 castPtr (Ptr addr) = Ptr addr
 
 plusPtr :: Ptr a -> Int -> Ptr b
-plusPtr (Ptr addr) (I# d) = Ptr (int2Addr# (addr2Int# addr +# d))
+plusPtr (Ptr addr) (I# d) = Ptr (plusAddr# addr d)
 
 alignPtr :: Ptr a -> Int -> Ptr a
 alignPtr addr@(Ptr a) (I# i)
-  = case addr2Int# a   of { ai ->
-    case remInt# ai i  of {
+  = case remAddr# a i of {
       0# -> addr;
-      n  -> Ptr (int2Addr# (ai +# (i -# n))) }}
+      n -> Ptr (plusAddr# a (i -# n)) }
 
 minusPtr :: Ptr a -> Ptr b -> Int
-minusPtr (Ptr a1) (Ptr a2) = I# (addr2Int# a1 -# addr2Int# a2)
+minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2)
 
 instance CCallable   (Ptr a)
 instance CReturnable (Ptr a)
@@ -44,7 +43,7 @@ instance CReturnable (Ptr a)
 data FunPtr a = FunPtr Addr# deriving (Eq, Ord)
 
 nullFunPtr :: FunPtr a
-nullFunPtr = FunPtr (int2Addr# 0#)
+nullFunPtr = FunPtr nullAddr#
 
 castFunPtr :: FunPtr a -> FunPtr b
 castFunPtr (FunPtr addr) = FunPtr addr
@@ -59,3 +58,4 @@ instance CCallable   (FunPtr a)
 instance CReturnable (FunPtr a)
 
 \end{code}
+
index 5332c63..a01c8e2 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Read.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Read.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -373,7 +373,7 @@ instance  (Integral a, Read a)  => Read (Ratio a)  where
                                (x,s)   <- reads r
                                ("%",t) <- lex s
                                (y,u)   <- reads t
-                               return (x%y,u))
+                               return (x % y,u))
 
 instance  (Read a) => Read [a]  where
     readsPrec _         = readList
@@ -554,23 +554,22 @@ point type to obtain the same results.
                    ReadS Double,
                    ReadS Float     #-} 
 readFloat :: (RealFloat a) => ReadS a
-readFloat r = do
-    (x,t) <- readRational r
-    return (fromRational x,t)
-
-readRational :: ReadS Rational -- NB: doesn't handle leading "-"
-
-readRational r =
-   (do 
-      (n,d,s) <- readFix r
-      (k,t)   <- readExp s
-      return ((n%1)*10^^(k-d), t )) ++
+readFloat r =
+   (do
+      (x,t) <- readRational r
+      return (fromRational x,t) ) ++
    (do
       ("NaN",t) <- lex r
       return (0/0,t) ) ++
    (do
       ("Infinity",t) <- lex r
       return (1/0,t) )
+
+readRational :: ReadS Rational -- NB: doesn't handle leading "-"
+readRational r = do 
+     (n,d,s) <- readFix r
+     (k,t)   <- readExp s
+     return ((n%1)*10^^(k-d), t)
  where
      readFix r = do
        (ds,s)  <- lexDecDigits r
index b453f6b..0c27ce3 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Real.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+% $Id: Real.lhs,v 1.2 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -62,6 +62,7 @@ their greatest common divisor.
 
 \begin{code}
 reduce ::  (Integral a) => a -> a -> Ratio a
+{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}
 reduce _ 0             =  error "Ratio.%: zero denominator"
 reduce x y             =  (x `quot` d) :% (y `quot` d)
                           where d = gcd x y
@@ -226,7 +227,7 @@ instance  (Integral a)      => Num (Ratio a)  where
 instance  (Integral a) => Fractional (Ratio a)  where
     {-# SPECIALIZE instance Fractional Rational #-}
     (x:%y) / (x':%y')  =  (x*y') % (y*x')
-    recip (x:%y)       =  if x < 0 then (-y) :% (-x) else y :% x
+    recip (x:%y)       =  % x
     fromRational (x:%y) =  fromInteger x :% fromInteger y
 
 instance  (Integral a) => Real (Ratio a)  where
index f98b33d..c36292c 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: ST.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+% $Id: ST.lhs,v 1.2 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -118,9 +118,9 @@ runST :: (forall s. ST s a) -> a
 runST st = runSTRep (case st of { ST st_rep -> st_rep })
 
 -- I'm only letting runSTRep be inlined right at the end, in particular *after* full laziness
--- That's what the "INLINE 100" says.
+-- That's what the "INLINE [0]" says.
 --             SLPJ Apr 99
-{-# INLINE 100 runSTRep #-}
+{-# INLINE [0] runSTRep #-}
 runSTRep :: (forall s. STRep s a) -> a
 runSTRep st_rep = case st_rep realWorld# of
                        (# _, r #) -> r
index cf9cea5..7145932 100644 (file)
@@ -3,7 +3,6 @@
 module GHC.STRef where
 
 import GHC.ST
-import GHC.Prim
 import GHC.Base
 
 data STRef s a = STRef (MutVar# s a)
index 3f83519..9a14dae 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Show.lhs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Show.lhs,v 1.4 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -246,8 +246,8 @@ itos n# cs
     itos' :: Int# -> String -> String
     itos' n# cs
         | n# <# 10#  = C# (chr# (ord# '0'# +# n#)) : cs
-        | otherwise = itos' (n# `quotInt#` 10#)
-                            (C# (chr# (ord# '0'# +# (n# `remInt#` 10#))) : cs)
+        | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
+                     itos' (n# `quotInt#` 10#) (C# c# : cs) }
 \end{code}
 
 %*********************************************************
index 4868c6d..afbbb9d 100644 (file)
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Storable.lhs,v 1.2 2001/07/31 13:10:01 simonmar Exp $
+% $Id: Storable.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -106,25 +106,25 @@ instance Storable (T) where {                     \
 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
         readWideCharOffPtr,writeWideCharOffPtr)
 
-STORABLE(Int,SIZEOF_LONG,ALIGNMENT_LONG,
+STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
         readIntOffPtr,writeIntOffPtr)
 
-STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
+STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
         readWordOffPtr,writeWordOffPtr)
 
-STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
+STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
         readPtrOffPtr,writePtrOffPtr)
 
-STORABLE((FunPtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
+STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
         readFunPtrOffPtr,writeFunPtrOffPtr)
 
-STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
+STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
         readStablePtrOffPtr,writeStablePtrOffPtr)
 
-STORABLE(Float,SIZEOF_FLOAT,ALIGNMENT_FLOAT,
+STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
         readFloatOffPtr,writeFloatOffPtr)
 
-STORABLE(Double,SIZEOF_DOUBLE,ALIGNMENT_DOUBLE,
+STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
         readDoubleOffPtr,writeDoubleOffPtr)
 
 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
@@ -220,30 +220,20 @@ readStablePtrOffPtr (Ptr a) (I# i)
   = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
 readInt8OffPtr (Ptr a) (I# i)
   = IO $ \s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)
-readInt16OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
-readInt32OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
-#if WORD_SIZE_IN_BYTES == 4
-readInt64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
-#else
-readInt64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I64# x #)
-#endif
 readWord8OffPtr (Ptr a) (I# i)
   = IO $ \s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)
+readInt16OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
 readWord16OffPtr (Ptr a) (I# i)
   = IO $ \s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)
+readInt32OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
 readWord32OffPtr (Ptr a) (I# i)
   = IO $ \s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)
-#if WORD_SIZE_IN_BYTES == 4
+readInt64OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
 readWord64OffPtr (Ptr a) (I# i)
   = IO $ \s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)
-#else
-readWord64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W64# x #)
-#endif
 
 writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
@@ -280,30 +270,20 @@ writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
   = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
 writeInt8OffPtr (Ptr a) (I# i) (I8# x)
   = IO $ \s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)
-writeInt16OffPtr (Ptr a) (I# i) (I16# x)
-  = IO $ \s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)
-writeInt32OffPtr (Ptr a) (I# i) (I32# x)
-  = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
-#if WORD_SIZE_IN_BYTES == 4
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
-  = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
-#else
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
-  = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
-#endif
 writeWord8OffPtr (Ptr a) (I# i) (W8# x)
   = IO $ \s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)
+writeInt16OffPtr (Ptr a) (I# i) (I16# x)
+  = IO $ \s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)
 writeWord16OffPtr (Ptr a) (I# i) (W16# x)
   = IO $ \s -> case writeWord16OffAddr# a i x s    of s2 -> (# s2, () #)
+writeInt32OffPtr (Ptr a) (I# i) (I32# x)
+  = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
 writeWord32OffPtr (Ptr a) (I# i) (W32# x)
   = IO $ \s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)
-#if WORD_SIZE_IN_BYTES == 4
+writeInt64OffPtr (Ptr a) (I# i) (I64# x)
+  = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
   = IO $ \s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)
-#else
-writeWord64OffPtr (Ptr a) (I# i) (W64# x)
-  = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
-#endif
 
 #endif /* __GLASGOW_HASKELL__ */
 \end{code}
index 95dd3a5..25515ba 100644 (file)
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Weak.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
+% $Id: Weak.lhs,v 1.3 2001/12/21 15:07:25 simonmar Exp $
 %
 % (c) The University of Glasgow, 1998-2000
 %
@@ -11,7 +11,6 @@
 
 module GHC.Weak where
 
-import GHC.Prim
 import GHC.Base
 import Data.Maybe
 import GHC.IOBase      ( IO(..), unIO )
index fe847fc..06a5c24 100644 (file)
@@ -132,18 +132,19 @@ instance Integral Word where
 
 instance Bounded Word where
     minBound = 0
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 31
+    maxBound = 0x7FFFFFFF
+#elif WORD_SIZE_IN_BITS == 32
     maxBound = 0xFFFFFFFF
 #else
     maxBound = 0xFFFFFFFFFFFFFFFF
 #endif
 
 instance Ix Word where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Word"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Word where
     readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
@@ -156,16 +157,13 @@ instance Bits Word where
     (W# x#) `shift` (I# i#)
         | i# >=# 0#          = W# (x# `shiftL#` i#)
         | otherwise          = W# (x# `shiftRL#` negateInt# i#)
-#if WORD_SIZE_IN_BYTES == 4
-    (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (32# -# i'#)))
+    (W# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W# x#
+        | otherwise  = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (wsib -# i'#)))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
-#else
-    (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (64# -# i'#)))
-        where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
-#endif
-    bitSize  _               = WORD_SIZE_IN_BYTES * 8
+        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+       wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
+    bitSize  _               = WORD_SIZE_IN_BITS
     isSigned _               = False
 
 {-# RULES
@@ -190,15 +188,15 @@ instance Show Word8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
 instance Num Word8 where
-    (W8# x#) + (W8# y#)    = W8# (wordToWord8# (x# `plusWord#` y#))
-    (W8# x#) - (W8# y#)    = W8# (wordToWord8# (x# `minusWord#` y#))
-    (W8# x#) * (W8# y#)    = W8# (wordToWord8# (x# `timesWord#` y#))
-    negate (W8# x#)        = W8# (wordToWord8# (int2Word# (negateInt# (word2Int# x#))))
+    (W8# x#) + (W8# y#)    = W8# (narrow8Word# (x# `plusWord#` y#))
+    (W8# x#) - (W8# y#)    = W8# (narrow8Word# (x# `minusWord#` y#))
+    (W8# x#) * (W8# y#)    = W8# (narrow8Word# (x# `timesWord#` y#))
+    negate (W8# x#)        = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#))))
     abs x                  = x
     signum 0               = 0
     signum _               = 1
-    fromInteger (S# i#)    = W8# (wordToWord8# (int2Word# i#))
-    fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#))
+    fromInteger (S# i#)    = W8# (narrow8Word# (int2Word# i#))
+    fromInteger (J# s# d#) = W8# (narrow8Word# (integer2Word# s# d#))
 
 instance Real Word8 where
     toRational x = toInteger x % 1
@@ -244,11 +242,10 @@ instance Bounded Word8 where
     maxBound = 0xFF
 
 instance Ix Word8 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Word8"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Word8 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -259,10 +256,12 @@ instance Bits Word8 where
     (W8# x#) `xor` (W8# y#)   = W8# (x# `xor#` y#)
     complement (W8# x#)       = W8# (x# `xor#` mb#) where W8# mb# = maxBound
     (W8# x#) `shift` (I# i#)
-        | i# >=# 0#           = W8# (wordToWord8# (x# `shiftL#` i#))
+        | i# >=# 0#           = W8# (narrow8Word# (x# `shiftL#` i#))
         | otherwise           = W8# (x# `shiftRL#` negateInt# i#)
-    (W8# x#) `rotate` (I# i#) = W8# (wordToWord8# ((x# `shiftL#` i'#) `or#`
-                                                   (x# `shiftRL#` (8# -# i'#))))
+    (W8# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W8# x#
+        | otherwise  = W8# (narrow8Word# ((x# `shiftL#` i'#) `or#`
+                                          (x# `shiftRL#` (8# -# i'#))))
         where
         i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
     bitSize  _                = 8
@@ -271,7 +270,7 @@ instance Bits Word8 where
 {-# RULES
 "fromIntegral/Word8->Word8"   fromIntegral = id :: Word8 -> Word8
 "fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer
-"fromIntegral/a->Word8"       fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (wordToWord8# x#)
+"fromIntegral/a->Word8"       fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#)
 "fromIntegral/Word8->a"       fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
   #-}
 
@@ -291,15 +290,15 @@ instance Show Word16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
 instance Num Word16 where
-    (W16# x#) + (W16# y#)  = W16# (wordToWord16# (x# `plusWord#` y#))
-    (W16# x#) - (W16# y#)  = W16# (wordToWord16# (x# `minusWord#` y#))
-    (W16# x#) * (W16# y#)  = W16# (wordToWord16# (x# `timesWord#` y#))
-    negate (W16# x#)       = W16# (wordToWord16# (int2Word# (negateInt# (word2Int# x#))))
+    (W16# x#) + (W16# y#)  = W16# (narrow16Word# (x# `plusWord#` y#))
+    (W16# x#) - (W16# y#)  = W16# (narrow16Word# (x# `minusWord#` y#))
+    (W16# x#) * (W16# y#)  = W16# (narrow16Word# (x# `timesWord#` y#))
+    negate (W16# x#)       = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#))))
     abs x                  = x
     signum 0               = 0
     signum _               = 1
-    fromInteger (S# i#)    = W16# (wordToWord16# (int2Word# i#))
-    fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#))
+    fromInteger (S# i#)    = W16# (narrow16Word# (int2Word# i#))
+    fromInteger (J# s# d#) = W16# (narrow16Word# (integer2Word# s# d#))
 
 instance Real Word16 where
     toRational x = toInteger x % 1
@@ -345,11 +344,10 @@ instance Bounded Word16 where
     maxBound = 0xFFFF
 
 instance Ix Word16 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Word16"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Word16 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -360,10 +358,12 @@ instance Bits Word16 where
     (W16# x#) `xor` (W16# y#)  = W16# (x# `xor#` y#)
     complement (W16# x#)       = W16# (x# `xor#` mb#) where W16# mb# = maxBound
     (W16# x#) `shift` (I# i#)
-        | i# >=# 0#            = W16# (wordToWord16# (x# `shiftL#` i#))
+        | i# >=# 0#            = W16# (narrow16Word# (x# `shiftL#` i#))
         | otherwise            = W16# (x# `shiftRL#` negateInt# i#)
-    (W16# x#) `rotate` (I# i#) = W16# (wordToWord16# ((x# `shiftL#` i'#) `or#`
-                                                      (x# `shiftRL#` (16# -# i'#))))
+    (W16# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W16# x#
+        | otherwise  = W16# (narrow16Word# ((x# `shiftL#` i'#) `or#`
+                                            (x# `shiftRL#` (16# -# i'#))))
         where
         i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
     bitSize  _                = 16
@@ -373,7 +373,7 @@ instance Bits Word16 where
 "fromIntegral/Word8->Word16"   fromIntegral = \(W8# x#) -> W16# x#
 "fromIntegral/Word16->Word16"  fromIntegral = id :: Word16 -> Word16
 "fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer
-"fromIntegral/a->Word16"       fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (wordToWord16# x#)
+"fromIntegral/a->Word16"       fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#)
 "fromIntegral/Word16->a"       fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
   #-}
 
@@ -381,37 +381,142 @@ instance Bits Word16 where
 -- type Word32
 ------------------------------------------------------------------------
 
+#if WORD_SIZE_IN_BITS < 32
+
+data Word32 = W32# Word32#
+
+instance Eq Word32 where
+    (W32# x#) == (W32# y#) = x# `eqWord32#` y#
+    (W32# x#) /= (W32# y#) = x# `neWord32#` y#
+
+instance Ord Word32 where
+    (W32# x#) <  (W32# y#) = x# `ltWord32#` y#
+    (W32# x#) <= (W32# y#) = x# `leWord32#` y#
+    (W32# x#) >  (W32# y#) = x# `gtWord32#` y#
+    (W32# x#) >= (W32# y#) = x# `geWord32#` y#
+
+instance Num Word32 where
+    (W32# x#) + (W32# y#)  = W32# (int32ToWord32# (word32ToInt32# x# `plusInt32#` word32ToInt32# y#))
+    (W32# x#) - (W32# y#)  = W32# (int32ToWord32# (word32ToInt32# x# `minusInt32#` word32ToInt32# y#))
+    (W32# x#) * (W32# y#)  = W32# (int32ToWord32# (word32ToInt32# x# `timesInt32#` word32ToInt32# y#))
+    negate (W32# x#)       = W32# (int32ToWord32# (negateInt32# (word32ToInt32# x#)))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger (S# i#)    = W32# (int32ToWord32# (intToInt32# i#))
+    fromInteger (J# s# d#) = W32# (integerToWord32# s# d#)
+
+instance Enum Word32 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word32"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word32"
+    toEnum i@(I# i#)
+        | i >= 0        = W32# (wordToWord32# (int2Word# i#))
+        | otherwise     = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
+    fromEnum x@(W32# x#)
+        | x <= fromIntegral (maxBound::Int)
+                        = I# (word2Int# (word32ToWord# x#))
+        | otherwise     = fromEnumError "Word32" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+
+instance Integral Word32 where
+    quot    x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `quotWord32#` y#)
+        | otherwise                 = divZeroError "quot{Word32}" x
+    rem     x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `remWord32#` y#)
+        | otherwise                 = divZeroError "rem{Word32}" x
+    div     x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `quotWord32#` y#)
+        | otherwise                 = divZeroError "div{Word32}" x
+    mod     x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `remWord32#` y#)
+        | otherwise                 = divZeroError "mod{Word32}" x
+    quotRem x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#))
+        | otherwise                 = divZeroError "quotRem{Word32}" x
+    divMod  x@(W32# x#) y@(W32# y#)
+        | y /= 0                    = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#))
+        | otherwise                 = divZeroError "quotRem{Word32}" x
+    toInteger x@(W32# x#)
+        | x <= fromIntegral (maxBound::Int)  = S# (word2Int# (word32ToWord# x#))
+        | otherwise                 = case word32ToInteger# x# of (# s, d #) -> J# s d
+
+instance Bits Word32 where
+    (W32# x#) .&.   (W32# y#)  = W32# (x# `and32#` y#)
+    (W32# x#) .|.   (W32# y#)  = W32# (x# `or32#`  y#)
+    (W32# x#) `xor` (W32# y#)  = W32# (x# `xor32#` y#)
+    complement (W32# x#)       = W32# (not32# x#)
+    (W32# x#) `shift` (I# i#)
+        | i# >=# 0#            = W32# (x# `shiftL32#` i#)
+        | otherwise            = W32# (x# `shiftRL32#` negateInt# i#)
+    (W32# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W32# x#
+        | otherwise  = W32# ((x# `shiftL32#` i'#) `or32#`
+                             (x# `shiftRL32#` (32# -# i'#)))
+        where
+        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+    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#
+
+{-# RULES
+"fromIntegral/Int->Word32"    fromIntegral = \(I#   x#) -> W32# (int32ToWord32# (intToInt32# x#))
+"fromIntegral/Word->Word32"   fromIntegral = \(W#   x#) -> W32# (wordToWord32# x#)
+"fromIntegral/Word32->Int"    fromIntegral = \(W32# x#) -> I#   (word2Int# (word32ToWord# x#))
+"fromIntegral/Word32->Word"   fromIntegral = \(W32# x#) -> W#   (word32ToWord# x#)
+"fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32
+  #-}
+
+#else 
+
 -- Word32 is represented in the same way as Word.
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
 -- Operations may assume and must ensure that it holds only values
 -- from its logical range.
 #endif
 
 data Word32 = W32# Word# deriving (Eq, Ord)
 
-instance CCallable Word32
-instance CReturnable Word32
-
-instance Show Word32 where
-#if WORD_SIZE_IN_BYTES == 4
-    showsPrec p x = showsPrec p (toInteger x)
-#else
-    showsPrec p x = showsPrec p (fromIntegral x :: Int)
-#endif
-
 instance Num Word32 where
-    (W32# x#) + (W32# y#)  = W32# (wordToWord32# (x# `plusWord#` y#))
-    (W32# x#) - (W32# y#)  = W32# (wordToWord32# (x# `minusWord#` y#))
-    (W32# x#) * (W32# y#)  = W32# (wordToWord32# (x# `timesWord#` y#))
-    negate (W32# x#)       = W32# (wordToWord32# (int2Word# (negateInt# (word2Int# x#))))
+    (W32# x#) + (W32# y#)  = W32# (narrow32Word# (x# `plusWord#` y#))
+    (W32# x#) - (W32# y#)  = W32# (narrow32Word# (x# `minusWord#` y#))
+    (W32# x#) * (W32# y#)  = W32# (narrow32Word# (x# `timesWord#` y#))
+    negate (W32# x#)       = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#))))
     abs x                  = x
     signum 0               = 0
     signum _               = 1
-    fromInteger (S# i#)    = W32# (wordToWord32# (int2Word# i#))
-    fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#))
-
-instance Real Word32 where
-    toRational x = toInteger x % 1
+    fromInteger (S# i#)    = W32# (narrow32Word# (int2Word# i#))
+    fromInteger (J# s# d#) = W32# (narrow32Word# (integer2Word# s# d#))
 
 instance Enum Word32 where
     succ x
@@ -422,12 +527,12 @@ instance Enum Word32 where
         | otherwise     = predError "Word32"
     toEnum i@(I# i#)
         | i >= 0
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
           && i <= fromIntegral (maxBound::Word32)
 #endif
                         = W32# (int2Word# i#)
         | otherwise     = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
     fromEnum x@(W32# x#)
         | x <= fromIntegral (maxBound::Int)
                         = I# (word2Int# x#)
@@ -462,7 +567,7 @@ instance Integral Word32 where
         | y /= 0                    = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
         | otherwise                 = divZeroError "quotRem{Word32}" x
     toInteger (W32# x#)
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
         | i# >=# 0#                 = S# i#
         | otherwise                 = case word2Integer# x# of (# s, d #) -> J# s d
         where
@@ -471,34 +576,18 @@ instance Integral Word32 where
                                     = S# (word2Int# x#)
 #endif
 
-instance Bounded Word32 where
-    minBound = 0
-    maxBound = 0xFFFFFFFF
-
-instance Ix Word32 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Word32"
-    inRange (m,n) i   = m <= i && i <= n
-
-instance Read Word32 where
-#if WORD_SIZE_IN_BYTES == 4
-    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
-#else
-    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-#endif
-
 instance Bits Word32 where
     (W32# x#) .&.   (W32# y#)  = W32# (x# `and#` y#)
     (W32# x#) .|.   (W32# y#)  = W32# (x# `or#`  y#)
     (W32# x#) `xor` (W32# y#)  = W32# (x# `xor#` y#)
     complement (W32# x#)       = W32# (x# `xor#` mb#) where W32# mb# = maxBound
     (W32# x#) `shift` (I# i#)
-        | i# >=# 0#            = W32# (wordToWord32# (x# `shiftL#` i#))
+        | i# >=# 0#            = W32# (narrow32Word# (x# `shiftL#` i#))
         | otherwise            = W32# (x# `shiftRL#` negateInt# i#)
-    (W32# x#) `rotate` (I# i#) = W32# (wordToWord32# ((x# `shiftL#` i'#) `or#`
-                                                      (x# `shiftRL#` (32# -# i'#))))
+    (W32# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W32# x#
+        | otherwise  = W32# (narrow32Word# ((x# `shiftL#` i'#) `or#`
+                                            (x# `shiftRL#` (32# -# i'#))))
         where
         i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
     bitSize  _                = 32
@@ -509,15 +598,48 @@ instance Bits Word32 where
 "fromIntegral/Word16->Word32"  fromIntegral = \(W16# x#) -> W32# x#
 "fromIntegral/Word32->Word32"  fromIntegral = id :: Word32 -> Word32
 "fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer
-"fromIntegral/a->Word32"       fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (wordToWord32# x#)
+"fromIntegral/a->Word32"       fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#)
 "fromIntegral/Word32->a"       fromIntegral = \(W32# x#) -> fromIntegral (W# x#)
   #-}
 
+#endif
+
+instance CCallable Word32
+instance CReturnable Word32
+
+instance Show Word32 where
+#if WORD_SIZE_IN_BITS < 33
+    showsPrec p x = showsPrec p (toInteger x)
+#else
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+#endif
+
+
+instance Real Word32 where
+    toRational x = toInteger x % 1
+
+instance Bounded Word32 where
+    minBound = 0
+    maxBound = 0xFFFFFFFF
+
+instance Ix Word32 where
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+
+instance Read Word32 where  
+#if WORD_SIZE_IN_BITS < 33
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+#else
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+#endif
+
 ------------------------------------------------------------------------
 -- type Word64
 ------------------------------------------------------------------------
 
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS < 64
 
 data Word64 = W64# Word64#
 
@@ -592,8 +714,10 @@ instance Bits Word64 where
     (W64# x#) `shift` (I# i#)
         | i# >=# 0#            = W64# (x# `shiftL64#` i#)
         | otherwise            = W64# (x# `shiftRL64#` negateInt# i#)
-    (W64# x#) `rotate` (I# i#) = W64# ((x# `shiftL64#` i'#) `or64#`
-                                       (x# `shiftRL64#` (64# -# i'#)))
+    (W64# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W64# x#
+        | otherwise  = W64# ((x# `shiftL64#` i'#) `or64#`
+                             (x# `shiftRL64#` (64# -# i'#)))
         where
         i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                = 64
@@ -607,13 +731,13 @@ foreign import "stg_gtWord64"      unsafe gtWord64#      :: Word64# -> Word64# -
 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_intToInt64"    unsafe intToInt64#    :: Int# -> Int64#
-foreign import "stg_wordToWord64"  unsafe wordToWord64#  :: Word# -> Word64#
-foreign import "stg_word64ToWord"  unsafe word64ToWord#  :: Word64# -> Word#
 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#
@@ -623,6 +747,9 @@ 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#
+
+
 {-# RULES
 "fromIntegral/Int->Word64"    fromIntegral = \(I#   x#) -> W64# (int64ToWord64# (intToInt64# x#))
 "fromIntegral/Word->Word64"   fromIntegral = \(W#   x#) -> W64# (wordToWord64# x#)
@@ -633,6 +760,10 @@ foreign import "stg_shiftRL64"     unsafe shiftRL64#     :: Word64# -> Int# -> W
 
 #else
 
+-- Word64 is represented in the same way as Word.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+
 data Word64 = W64# Word# deriving (Eq, Ord)
 
 instance Num Word64 where
@@ -698,8 +829,10 @@ instance Bits Word64 where
     (W64# x#) `shift` (I# i#)
         | i# >=# 0#            = W64# (x# `shiftL#` i#)
         | otherwise            = W64# (x# `shiftRL#` negateInt# i#)
-    (W64# x#) `rotate` (I# i#) = W64# ((x# `shiftL#` i'#) `or#`
-                                       (x# `shiftRL#` (64# -# i'#)))
+    (W64# x#) `rotate` (I# i#)
+        | i'# ==# 0# = W64# x#
+        | otherwise  = W64# ((x# `shiftL#` i'#) `or#`
+                             (x# `shiftRL#` (64# -# i'#)))
         where
         i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                = 64
@@ -726,11 +859,10 @@ instance Bounded Word64 where
     maxBound = 0xFFFFFFFFFFFFFFFF
 
 instance Ix Word64 where
-    range (m,n)       = [m..n]
-    index b@(m,_) i
-        | inRange b i = fromIntegral (i - m)
-        | otherwise   = indexError b i "Word64"
-    inRange (m,n) i   = m <= i && i <= n
+    range (m,n)              = [m..n]
+    unsafeIndex b@(m,_) i    = fromIntegral (i - m)
+    inRange (m,n) i          = m <= i && i <= n
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
 
 instance Read Word64 where
     readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
index 6c8f6bb..1240ea8 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.6 2001/09/13 11:35:09 simonmar Exp $
+# $Id: Makefile,v 1.7 2001/12/21 15:07:20 simonmar Exp $
 
 TOP=..
 include $(TOP)/mk/boilerplate.mk
@@ -37,13 +37,34 @@ ALL_DIRS = \
 
 PKG=core
 
-# dependencies between .hsc files
-GHC/IO.hs : GHC/Handle.hs
+# -----------------------------------------------------------------------------
+# PrimOpWrappers
+
+GHC/PrimopWrappers.hs: $(GHC_COMPILER_DIR)/prelude/primops.txt
+       rm -f $@
+       $(GHC_GENPRIMOP) --make-haskell-wrappers < $< > $@
+
+boot :: GHC/PrimOpWrappers.hs
+
+CLEAN_FILES += GHC/PrimopWrappers.hs
+
+# -----------------------------------------------------------------------------
+# GHC/Prim.hi-boot
+
+#GHC/Prim.$(way_)hi    : GHC/Prim.hi-boot
+#      cp $< $@
+#
+#ALL_PRIMS = GHC/Prim.hi $(foreach way, $(WAYS), GHC/Prim.$(way)_hi)
+#
+#lib  : $(ALL_PRIMS)
+#
+#boot :: $(ALL_PRIMS)
+#
+#CLEAN_FILES += $(ALL_PRIMS)
 
-GHC/Prim.$(way_)hi : GHC/Prim.hi-boot
-       cp $< $@
+lib : GHC/Prim.hi-boot
 
-lib : GHC/Prim.$(way_)hi
+SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR) -traditional
 
 # -----------------------------------------------------------------------------
 
index e868757..de4186a 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: CPUTime.hsc,v 1.4 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: CPUTime.hsc,v 1.5 2001/12/21 15:07:26 simonmar Exp $
 --
 -- The standard CPUTime library.
 --
@@ -17,7 +17,7 @@
 module System.CPUTime 
        (
          getCPUTime,       -- :: IO Integer
-        cpuTimePrecision  -- :: Integer
+        cpuTimePrecision  -- :: Integer
         ) where
 
 import Prelude
@@ -55,10 +55,10 @@ getCPUTime = do
 
     let ru_utime = (#ptr struct rusage, ru_utime) p_rusage
     let ru_stime = (#ptr struct rusage, ru_stime) p_rusage
-    u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CLong
-    u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CLong
-    s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CLong
-    s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CLong
+    u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CTime
+    u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime
+    s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CTime
+    s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime
 
     return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec + 
              fromIntegral s_sec * 1000000 + fromIntegral s_usec) 
index c0fe1f9..6b7c570 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Environment.hs,v 1.2 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: Environment.hs,v 1.3 2001/12/21 15:07:26 simonmar Exp $
 --
 -- Miscellaneous information about the system environment.
 --
@@ -41,12 +41,13 @@ getArgs =
   alloca $ \ p_argc ->  
   alloca $ \ p_argv -> do
    getProgArgv p_argc p_argv
-   p    <- peek p_argc
+   p    <- fromIntegral `liftM` peek p_argc
    argv <- peek p_argv
    peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
+
    
-   
-foreign import "getProgArgv" getProgArgv :: Ptr Int -> Ptr (Ptr CString) -> IO ()
+foreign import "getProgArgv" unsafe 
+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
 
 -- Computation `getProgName' returns the name of the program
 -- as it was invoked.
@@ -62,13 +63,23 @@ getProgName =
 unpackProgName :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 unpackProgName argv = do 
   s <- peekElemOff argv 0 >>= peekCString
-  return (de_slash "" s)
+  return (basename s)
   where
-    -- re-start accumulating at every '/'
-    de_slash :: String -> String -> String
-    de_slash  acc []      = reverse acc
-    de_slash _acc ('/':xs) = de_slash []      xs
-    de_slash  acc (x:xs)   = de_slash (x:acc) xs
+   basename :: String -> String
+   basename f = go f f
+    where
+      go acc [] = acc
+      go acc (x:xs) 
+        | isPathSeparator x = go xs xs
+        | otherwise         = go acc xs
+
+   isPathSeparator :: Char -> Bool
+   isPathSeparator '/'  = True
+#ifdef mingw32_TARGET_OS 
+   isPathSeparator '\\' = True
+#endif
+   isPathSeparator _    = False
+
 
 -- Computation `getEnv var' returns the value
 -- of the environment variable {\em var}.  
index 0544ea9..c40704d 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: StableName.hs,v 1.2 2001/09/13 11:37:08 simonmar Exp $
+-- $Id: StableName.hs,v 1.3 2001/12/21 15:07:26 simonmar Exp $
 --
 -- Giving an object a stable (GC-invariant) name.
 --
@@ -25,9 +25,8 @@ import Prelude
 import Data.Dynamic
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Base                ( Int(..) )
 import GHC.IOBase      ( IO(..) )
-import GHC.Prim                ( StableName#, makeStableName#
+import GHC.Base                ( Int(..), StableName#, makeStableName#
                        , eqStableName#, stableNameToInt# )
 
 -----------------------------------------------------------------------------
index aa3ddf6..c0633aa 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Random.hs,v 1.1 2001/06/28 14:15:04 simonmar Exp $
+-- $Id: Random.hs,v 1.2 2001/12/21 15:07:26 simonmar Exp $
 --
 -- Random numbers.
 --
@@ -16,7 +16,7 @@
 
 module System.Random
        (
-         RandomGen(next, split)
+         RandomGen(next, split, genRange)
        , StdGen
        , mkStdGen
        , Random ( random,   randomR,
@@ -53,8 +53,12 @@ import System.Time   ( getClockTime, ClockTime(..) )
 #endif
 
 class RandomGen g where
-   next  :: g -> (Int, g)
-   split :: g -> (g, g)
+   next     :: g -> (Int, g)
+   split    :: g -> (g, g)
+   genRange :: g -> (Int,Int)
+
+   -- default mathod
+   genRange g = (minBound,maxBound)
 
 
 data StdGen 
index 45cb695..e5cf6b0 100644 (file)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Time.hsc,v 1.5 2001/08/17 12:50:34 simonmar Exp $
+-- $Id: Time.hsc,v 1.6 2001/12/21 15:07:26 simonmar Exp $
 --
 -- The standard Time library.
 --
@@ -205,9 +205,9 @@ noTimeDiff = TimeDiff 0 0 0 0 0 0 0
 getClockTime = do
   allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do
     throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr
-    sec  <- (#peek struct timeval,tv_sec)  p_timeval :: IO Int32
-    usec <- (#peek struct timeval,tv_usec) p_timeval :: IO Int32
-    return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000))
+    sec  <- (#peek struct timeval,tv_sec)  p_timeval :: IO CTime
+    usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime
+    return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000))
  
 #elif HAVE_FTIME
 getClockTime = do
@@ -215,7 +215,7 @@ getClockTime = do
   ftime p_timeb
   sec  <- (#peek struct timeb,time) p_timeb :: IO CTime
   msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort
-  return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-}))
+  return (TOD (fromIntegral sec) (fromIntegral msec * 1000000000))
 
 #else /* use POSIX time() */
 getClockTime = do
@@ -470,7 +470,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec
         -- 
         gmtoff <- gmtoff p_tm
        let res = fromIntegral t - tz + fromIntegral gmtoff
-       return (TOD (fromIntegral res) 0)
+       return (TOD (fromIntegral res) psec)
 
 -- -----------------------------------------------------------------------------
 -- Converting time values to strings.
diff --git a/cbits/PrelIOUtils.c b/cbits/PrelIOUtils.c
new file mode 100644 (file)
index 0000000..44065b8
--- /dev/null
@@ -0,0 +1,9 @@
+/* 
+ * (c) The University of Glasgow 2001
+ *
+ * static versions of the inline functions in HsCore.h
+ */
+
+#define INLINE
+#include "HsCore.h"
+
diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c
new file mode 100644 (file)
index 0000000..a224004
--- /dev/null
@@ -0,0 +1,75 @@
+/* 
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-
+ *
+ * Directory Runtime Support
+ */
+#include "dirUtils.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
+
+HsInt
+prel_mkdir(HsAddr pathName, HsInt mode)
+{
+#if defined(mingw32_TARGET_OS)
+  return mkdir(pathName);
+#else
+  return mkdir(pathName,mode);
+#endif
+}
+
+HsInt
+prel_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
+}
+
+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; }
+
+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);
+#endif
+}
+
+HsInt prel_end_of_dir()
+{
+#ifndef mingw32_TARGET_OS
+  return 0;
+#else
+  return ENOENT;
+#endif  
+}
+
index b8e7907..d095ee2 100644 (file)
@@ -1,7 +1,7 @@
 /* 
  * (c) The University of Glasgow, 2000-2001
  *
- * $Id: errno.c,v 1.2 2001/07/31 11:51:09 simonmar Exp $
+ * $Id: errno.c,v 1.3 2001/12/21 15:07:26 simonmar Exp $
  *
  * GHC Error Number Conversion
  */
 int *ghcErrno(void) {
   return &errno;
 }
+
+
+/* Wrappers for the individual error codes - boring */
+#define ErrCode(x) HsInt prel_error_##x() { return x; }
+#define ErrCode2(x,y) HsInt prel_error_##x() { return y; }
+
+#ifdef E2BIG
+ErrCode(E2BIG)
+#else
+ErrCode2(E2BIG,-1)
+#endif
+
+#ifdef EACCES
+ErrCode(EACCES)
+#else
+ErrCode2(EACCES,-1)
+#endif
+
+#ifdef EADDRINUSE
+ErrCode(EADDRINUSE)
+#else
+ErrCode2(EADDRINUSE,-1)
+#endif
+
+#ifdef EADDRNOTAVAIL
+ErrCode(EADDRNOTAVAIL)
+#else
+ErrCode2(EADDRNOTAVAIL,-1)
+#endif
+
+#ifdef EADV
+ErrCode(EADV)
+#else
+ErrCode2(EADV,-1)
+#endif
+
+#ifdef EAFNOSUPPORT
+ErrCode(EAFNOSUPPORT)
+#else
+ErrCode2(EAFNOSUPPORT,-1)
+#endif
+
+#ifdef EAGAIN
+ErrCode(EAGAIN)
+#else
+ErrCode2(EAGAIN,-1)
+#endif
+
+#ifdef EALREADY
+ErrCode(EALREADY)
+#else
+ErrCode2(EALREADY,-1)
+#endif
+
+#ifdef EBADF
+ErrCode(EBADF)
+#else
+ErrCode2(EBADF,-1)
+#endif
+
+#ifdef EBADMSG
+ErrCode(EBADMSG)
+#else
+ErrCode2(EBADMSG,-1)
+#endif
+
+#ifdef EBADRPC
+ErrCode(EBADRPC)
+#else
+ErrCode2(EBADRPC,-1)
+#endif
+
+#ifdef EBUSY
+ErrCode(EBUSY)
+#else
+ErrCode2(EBUSY,-1)
+#endif
+
+#ifdef ECHILD
+ErrCode(ECHILD)
+#else
+ErrCode2(ECHILD,-1)
+#endif
+
+#ifdef ECOMM
+ErrCode(ECOMM)
+#else
+ErrCode2(ECOMM,-1)
+#endif
+
+#ifdef ECONNABORTED
+ErrCode(ECONNABORTED)
+#else
+ErrCode2(ECONNABORTED,-1)
+#endif
+
+#ifdef ECONNREFUSED
+ErrCode(ECONNREFUSED)
+#else
+ErrCode2(ECONNREFUSED,-1)
+#endif
+
+#ifdef ECONNRESET
+ErrCode(ECONNRESET)
+#else
+ErrCode2(ECONNRESET,-1)
+#endif
+
+#ifdef EDEADLK
+ErrCode(EDEADLK)
+#else
+ErrCode2(EDEADLK,-1)
+#endif
+
+#ifdef EDESTADDRREQ
+ErrCode(EDESTADDRREQ)
+#else
+ErrCode2(EDESTADDRREQ,-1)
+#endif
+
+#ifdef EDIRTY
+ErrCode(EDIRTY)
+#else
+ErrCode2(EDIRTY,-1)
+#endif
+
+#ifdef EDOM
+ErrCode(EDOM)
+#else
+ErrCode2(EDOM,-1)
+#endif
+
+#ifdef EDQUOT
+ErrCode(EDQUOT)
+#else
+ErrCode2(EDQUOT,-1)
+#endif
+
+#ifdef EEXIST
+ErrCode(EEXIST)
+#else
+ErrCode2(EEXIST,-1)
+#endif
+
+#ifdef EFAULT
+ErrCode(EFAULT)
+#else
+ErrCode2(EFAULT,-1)
+#endif
+
+#ifdef EFBIG
+ErrCode(EFBIG)
+#else
+ErrCode2(EFBIG,-1)
+#endif
+
+#ifdef EFTYPE
+ErrCode(EFTYPE)
+#else
+ErrCode2(EFTYPE,-1)
+#endif
+
+#ifdef EHOSTDOWN
+ErrCode(EHOSTDOWN)
+#else
+ErrCode2(EHOSTDOWN,-1)
+#endif
+
+#ifdef EHOSTUNREACH
+ErrCode(EHOSTUNREACH)
+#else
+ErrCode2(EHOSTUNREACH,-1)
+#endif
+
+#ifdef EIDRM
+ErrCode(EIDRM)
+#else
+ErrCode2(EIDRM,-1)
+#endif
+
+#ifdef EILSEQ
+ErrCode(EILSEQ)
+#else
+ErrCode2(EILSEQ,-1)
+#endif
+
+#ifdef EINPROGRESS
+ErrCode(EINPROGRESS)
+#else
+ErrCode2(EINPROGRESS,-1)
+#endif
+
+#ifdef EINTR
+ErrCode(EINTR)
+#else
+ErrCode2(EINTR,-1)
+#endif
+
+#ifdef EINVAL
+ErrCode(EINVAL)
+#else
+ErrCode2(EINVAL,-1)
+#endif
+
+#ifdef EIO
+ErrCode(EIO)
+#else
+ErrCode2(EIO,-1)
+#endif
+
+#ifdef EISCONN
+ErrCode(EISCONN)
+#else
+ErrCode2(EISCONN,-1)
+#endif
+
+#ifdef EISDIR
+ErrCode(EISDIR)
+#else
+ErrCode2(EISDIR,-1)
+#endif
+
+#ifdef ELOOP
+ErrCode(ELOOP)
+#else
+ErrCode2(ELOOP,-1)
+#endif
+
+#ifdef EMFILE
+ErrCode(EMFILE)
+#else
+ErrCode2(EMFILE,-1)
+#endif
+
+#ifdef EMLINK
+ErrCode(EMLINK)
+#else
+ErrCode2(EMLINK,-1)
+#endif
+
+#ifdef EMSGSIZE
+ErrCode(EMSGSIZE)
+#else
+ErrCode2(EMSGSIZE,-1)
+#endif
+
+#ifdef EMULTIHOP
+ErrCode(EMULTIHOP)
+#else
+ErrCode2(EMULTIHOP,-1)
+#endif
+
+#ifdef ENAMETOOLONG
+ErrCode(ENAMETOOLONG)
+#else
+ErrCode2(ENAMETOOLONG,-1)
+#endif
+
+#ifdef ENETDOWN
+ErrCode(ENETDOWN)
+#else
+ErrCode2(ENETDOWN,-1)
+#endif
+
+#ifdef ENETRESET
+ErrCode(ENETRESET)
+#else
+ErrCode2(ENETRESET,-1)
+#endif
+
+#ifdef ENETUNREACH
+ErrCode(ENETUNREACH)
+#else
+ErrCode2(ENETUNREACH,-1)
+#endif
+
+#ifdef ENFILE
+ErrCode(ENFILE)
+#else
+ErrCode2(ENFILE,-1)
+#endif
+
+#ifdef ENOBUFS
+ErrCode(ENOBUFS)
+#else
+ErrCode2(ENOBUFS,-1)
+#endif
+
+#ifdef ENODATA
+ErrCode(ENODATA)
+#else
+ErrCode2(ENODATA,-1)
+#endif
+
+#ifdef ENODEV
+ErrCode(ENODEV)
+#else
+ErrCode2(ENODEV,-1)
+#endif
+
+#ifdef ENOENT
+ErrCode(ENOENT)
+#else
+ErrCode2(ENOENT,-1)
+#endif
+
+#ifdef ENOEXEC
+ErrCode(ENOEXEC)
+#else
+ErrCode2(ENOEXEC,-1)
+#endif
+
+#ifdef ENOLCK
+ErrCode(ENOLCK)
+#else
+ErrCode2(ENOLCK,-1)
+#endif
+
+#ifdef ENOLINK
+ErrCode(ENOLINK)
+#else
+ErrCode2(ENOLINK,-1)
+#endif
+
+#ifdef ENOMEM
+ErrCode(ENOMEM)
+#else
+ErrCode2(ENOMEM,-1)
+#endif
+
+#ifdef ENOMSG
+ErrCode(ENOMSG)
+#else
+ErrCode2(ENOMSG,-1)
+#endif
+
+#ifdef ENONET
+ErrCode(ENONET)
+#else
+ErrCode2(ENONET,-1)
+#endif
+
+#ifdef ENOPROTOOPT
+ErrCode(ENOPROTOOPT)
+#else
+ErrCode2(ENOPROTOOPT,-1)
+#endif
+
+#ifdef ENOSPC
+ErrCode(ENOSPC)
+#else
+ErrCode2(ENOSPC,-1)
+#endif
+
+#ifdef ENOSR
+ErrCode(ENOSR)
+#else
+ErrCode2(ENOSR,-1)
+#endif
+
+#ifdef ENOSTR
+ErrCode(ENOSTR)
+#else
+ErrCode2(ENOSTR,-1)
+#endif
+
+#ifdef ENOSYS
+ErrCode(ENOSYS)
+#else
+ErrCode2(ENOSYS,-1)
+#endif
+
+#ifdef ENOTBLK
+ErrCode(ENOTBLK)
+#else
+ErrCode2(ENOTBLK,-1)
+#endif
+
+#ifdef ENOTCONN
+ErrCode(ENOTCONN)
+#else
+ErrCode2(ENOTCONN,-1)
+#endif
+
+#ifdef ENOTDIR
+ErrCode(ENOTDIR)
+#else
+ErrCode2(ENOTDIR,-1)
+#endif
+
+#ifdef ENOTEMPTY
+ErrCode(ENOTEMPTY)
+#else
+ErrCode2(ENOTEMPTY,-1)
+#endif
+
+#ifdef ENOTSOCK
+ErrCode(ENOTSOCK)
+#else
+ErrCode2(ENOTSOCK,-1)
+#endif
+
+#ifdef ENOTTY
+ErrCode(ENOTTY)
+#else
+ErrCode2(ENOTTY,-1)
+#endif
+
+#ifdef ENXIO
+ErrCode(ENXIO)
+#else
+ErrCode2(ENXIO,-1)
+#endif
+
+#ifdef EOPNOTSUPP
+ErrCode(EOPNOTSUPP)
+#else
+ErrCode2(EOPNOTSUPP,-1)
+#endif
+
+#ifdef EPERM
+ErrCode(EPERM)
+#else
+ErrCode2(EPERM,-1)
+#endif
+
+#ifdef EPFNOSUPPORT
+ErrCode(EPFNOSUPPORT)
+#else
+ErrCode2(EPFNOSUPPORT,-1)
+#endif
+
+#ifdef EPIPE
+ErrCode(EPIPE)
+#else
+ErrCode2(EPIPE,-1)
+#endif
+
+#ifdef EPROCLIM
+ErrCode(EPROCLIM)
+#else
+ErrCode2(EPROCLIM,-1)
+#endif
+
+#ifdef EPROCUNAVAIL
+ErrCode(EPROCUNAVAIL)
+#else
+ErrCode2(EPROCUNAVAIL,-1)
+#endif
+
+#ifdef EPROGMISMATCH
+ErrCode(EPROGMISMATCH)
+#else
+ErrCode2(EPROGMISMATCH,-1)
+#endif
+
+#ifdef EPROGUNAVAIL
+ErrCode(EPROGUNAVAIL)
+#else
+ErrCode2(EPROGUNAVAIL,-1)
+#endif
+
+#ifdef EPROTO
+ErrCode(EPROTO)
+#else
+ErrCode2(EPROTO,-1)
+#endif
+
+#ifdef EPROTONOSUPPORT
+ErrCode(EPROTONOSUPPORT)
+#else
+ErrCode2(EPROTONOSUPPORT,-1)
+#endif
+
+#ifdef EPROTOTYPE
+ErrCode(EPROTOTYPE)
+#else
+ErrCode2(EPROTOTYPE,-1)
+#endif
+
+#ifdef ERANGE
+ErrCode(ERANGE)
+#else
+ErrCode2(ERANGE,-1)
+#endif
+
+#ifdef EREMCHG
+ErrCode(EREMCHG)
+#else
+ErrCode2(EREMCHG,-1)
+#endif
+
+#ifdef EREMOTE
+ErrCode(EREMOTE)
+#else
+ErrCode2(EREMOTE,-1)
+#endif
+
+#ifdef EROFS
+ErrCode(EROFS)
+#else
+ErrCode2(EROFS,-1)
+#endif
+
+#ifdef ERPCMISMATCH
+ErrCode(ERPCMISMATCH)
+#else
+ErrCode2(ERPCMISMATCH,-1)
+#endif
+
+#ifdef ERREMOTE
+ErrCode(ERREMOTE)
+#else
+ErrCode2(ERREMOTE,-1)
+#endif
+
+#ifdef ESHUTDOWN
+ErrCode(ESHUTDOWN)
+#else
+ErrCode2(ESHUTDOWN,-1)
+#endif
+
+#ifdef ESOCKTNOSUPPORT
+ErrCode(ESOCKTNOSUPPORT)
+#else
+ErrCode2(ESOCKTNOSUPPORT,-1)
+#endif
+
+#ifdef ESPIPE
+ErrCode(ESPIPE)
+#else
+ErrCode2(ESPIPE,-1)
+#endif
+
+#ifdef ESRCH
+ErrCode(ESRCH)
+#else
+ErrCode2(ESRCH,-1)
+#endif
+
+#ifdef ESRMNT
+ErrCode(ESRMNT)
+#else
+ErrCode2(ESRMNT,-1)
+#endif
+
+#ifdef ESTALE
+ErrCode(ESTALE)
+#else
+ErrCode2(ESTALE,-1)
+#endif
+
+#ifdef ETIME
+ErrCode(ETIME)
+#else
+ErrCode2(ETIME,-1)
+#endif
+
+#ifdef ETIMEDOUT
+ErrCode(ETIMEDOUT)
+#else
+ErrCode2(ETIMEDOUT,-1)
+#endif
+
+#ifdef ETOOMANYREFS
+ErrCode(ETOOMANYREFS)
+#else
+ErrCode2(ETOOMANYREFS,-1)
+#endif
+
+#ifdef ETXTBSY
+ErrCode(ETXTBSY)
+#else
+ErrCode2(ETXTBSY,-1)
+#endif
+
+#ifdef EUSERS
+ErrCode(EUSERS)
+#else
+ErrCode2(EUSERS,-1)
+#endif
+
+#ifdef EWOULDBLOCK
+ErrCode(EWOULDBLOCK)
+#else
+ErrCode2(EWOULDBLOCK,-1)
+#endif
+
+#ifdef EXDEV
+ErrCode(EXDEV)
+#else
+ErrCode2(EXDEV,-1)
+#endif
+
index ae60ab7..ab3f84b 100644 (file)
@@ -1,7 +1,7 @@
 /* 
  * (c) The GHC Team 2001
  *
- * $Id: ilxstubs.c,v 1.1 2001/08/17 12:47:10 simonmar Exp $
+ * $Id: ilxstubs.c,v 1.2 2001/12/21 15:07:26 simonmar Exp $
  *
  * ILX stubs for external function calls
  */
@@ -59,8 +59,14 @@ stackOverflow(void)
 {
 }
 
+void *
+_ErrorHdrHook(void)
+{
+  return &ErrorHdrHook;
+}
+
 void
-ErrorHdrHook (long fd)
+ErrorHdrHook(long fd)
 {
     const char msg[] = "\nFail: ";
     write(fd, msg, sizeof(msg)-1);
index 79a605a..6585de9 100644 (file)
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: inputReady.c,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+ * $Id: inputReady.c,v 1.4 2001/12/21 15:07:26 simonmar Exp $
  *
  * hReady Runtime Support
  */
  * *character* from this file object without blocking?'
  */
 int
-inputReady(int fd, int msecs)
+inputReady(int fd, int msecs, int isSock)
 {
+  if 
 #ifndef mingw32_TARGET_OS
+    ( 1 ) {
+#else
+    ( isSock ) {
+#endif
     int maxfd, ready;
     fd_set rfd;
     struct timeval tv;
-#endif
 
-#ifdef mingw32_TARGET_OS
-    return 1;
-#else
     FD_ZERO(&rfd);
     FD_SET(fd, &rfd);
 
@@ -45,6 +46,23 @@ inputReady(int fd, int msecs)
 
     /* 1 => Input ready, 0 => not ready, -1 => error */
     return (ready);
-
+#ifdef mingw32_TARGET_OS
+    } else {
+      DWORD rc;
+      HANDLE hFile = (HANDLE)_get_osfhandle(fd);
+    
+      rc = MsgWaitForMultipleObjects( 1,
+                                     &hFile,
+                                     FALSE, /* wait all */
+                                     msecs, /*millisecs*/
+                                     QS_ALLEVENTS);
+    
+      /* 1 => Input ready, 0 => not ready, -1 => error */
+      switch (rc) {
+       case WAIT_TIMEOUT: return 0;
+       case WAIT_OBJECT_0: return 1;
+       default: return -1;
+      }
+    }
 #endif
-}
+  }}
index 8118afd..4e2af36 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.1 2001/07/31 12:52:37 simonmar Exp $
+ * $Id: longlong.c,v 1.2 2001/12/21 15:07:26 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -74,8 +74,8 @@ StgInt64  stg_iShiftRA64 (StgInt64 a,  StgInt b)    {return a >> b;}
 StgInt64  stg_iShiftRL64 (StgInt64 a,  StgInt b)
 {return (StgInt64) ((StgWord64) a >> b);}
 
-/* Casting between longs and longer longs:
-   (the primops that cast between Integers and long longs are
+/* Casting between longs and longer longs.
+   (the primops that cast from long longs to Integers
    expressed as macros, since these may cause some heap allocation).
 */
 
@@ -86,4 +86,40 @@ StgWord64 stg_wordToWord64  (StgWord   w) {return (StgWord64) w;}
 StgWord   stg_word64ToWord  (StgWord64 w) {return (StgWord)   w;}
 StgInt64  stg_word64ToInt64 (StgWord64 w) {return (StgInt64)  w;}
 
+StgWord64 stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da)
+{ 
+  mp_limb_t* d;
+  I_ s;
+  StgWord64 res;
+  d = (mp_limb_t *)da;
+  s = sa;
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -d[0]; break;
+    default:
+      res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
+StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da)
+{ 
+  mp_limb_t* d;
+  I_ s;
+  StgInt64 res;
+  d = (mp_limb_t *)da;
+  s = (sa);
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -d[0]; break;
+    default:
+      res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
 #endif /* SUPPORT_LONG_LONGS */
index 805094f..6534ca8 100644 (file)
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
  *
- * $Id: system.c,v 1.3 2001/08/17 12:50:34 simonmar Exp $
+ * $Id: system.c,v 1.4 2001/12/21 15:07:26 simonmar Exp $
  *
  * system Runtime Support
  */
@@ -13,6 +13,7 @@
 
 #if defined(mingw32_TARGET_OS)
 #include <windows.h>
+#include <stdlib.h>
 #endif
 
 HsInt
@@ -20,8 +21,7 @@ systemCmd(HsAddr cmd)
 {
   /* -------------------- WINDOWS VERSION --------------------- */
 #if defined(mingw32_TARGET_OS)
-  if (system(cmd) < 0) return -1;
-  return 0;
+    return system(cmd);
 #else
   /* -------------------- UNIX VERSION --------------------- */
     int pid;
index e4f0247..2ab4ce9 100644 (file)
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1998
  *
- * $Id: writeError.c,v 1.2 2001/07/31 11:51:09 simonmar Exp $
+ * $Id: writeError.c,v 1.3 2001/12/21 15:07:26 simonmar Exp $
  *
  * hPutStr Runtime Support
  */
@@ -20,8 +20,10 @@ implementation in one or two places.)
 #include "RtsUtils.h"
 #include "HsCore.h"
 
+#include "PrelIOUtils.h"
+
 void
-writeErrString__ (HsAddr msg_hdr, HsAddr msg, HsInt len)
+writeErrString__(HsAddr msg_hdr, HsAddr msg, HsInt len)
 {
   int count = 0;
   char* p  = (char*)msg;
index 2649483..7f4b230 100644 (file)
     <para>We first classify each node in the hierarchy according to
     one of the following terms:</para>
 
+    ToDo: unpublished interfaces.
+
     <variablelist>
       <varlistentry>
        <term>Allocated</term>
          <para>The <literal>User</literal> hierarchy is reserved for
          users: a user may always use the portion of the hierarchy
          which is formed from his/her email address as follows:
-         replace the <literal>@</literal> by a <literal>.</literal>,
-         reverse the order of the components, capitalise the first
-         letter of each component, and prepend
-         <literal>User.</literal>.  For example,
+         replace any <quote><literal>.</literal></quote>s in the
+         username (before the <literal>@</literal>) with
+         <quote><literal>_</literal></quote>, replace the
+         <quote><literal>@</literal></quote> by a
+         <quote><literal>.</literal></quote>, reverse the order of
+         the components, capitalise the first letter of each
+         component, and prepend
+         <quote><literal>User.</literal></quote>.  For example,
          <literal>simonmar@microsoft.com</literal> becomes
          <literal>User.Com.Microsoft.Simonmar</literal>.</para>
        </listitem>
         are never grouped by standards compliance, portability,
         stability, or any other property.</para>
       </blockquote>
+
+      <para>There are some other considerations when choosing where to
+      place libraries.  Where possible, choose a layout that finds a
+      good compromise between depth of nesting and logical grouping of
+      functionality; for example, although the <literal>Text</literal>
+      hierarchy could logically be placed as a child of
+      <literal>FileFormat</literal>, we choose not to because
+      <literal>Text</literal> is ubiquitous and we don't want to have
+      to type the extra component all the time.</para>
+
+      <para>Also consider consistency: if a particular sub-hierarchy
+      provides similar functionality to another sub-hierarchy in the
+      tree, then preferably the structure of the two subtrees should
+      also be similar.  For example: under
+      <literal>Language.Haskell</literal> we have children
+      <literal>Syntax</literal>, <literal>Lexer</literal>,
+      <literal>Parser</literal> etc., so under
+      <literal>Language.C</literal> we should have a similar
+      structure.</para>
     </sect2>
 
     <sect2 id="module-naming-convention">
@@ -631,10 +656,15 @@ import Text.HTML.Internals -- The non-abstract library
     <literal>Foreign</literal>, <emphasis>ToDo: what
     else?</emphasis>.</para>
 
+    <para>There is one further requirement: only licenses approved by
+    the Open Source Initiative may be used with the core libraries.
+    See <ulink url="http://www.opensource.org//">The Open Source
+    Initiative</ulink> for a list of approved licensees.</para>
+
     <para><emphasis>ToDo: include a prototype BSD license
     here</emphasis>.</para>
   </sect1>
-    
+
   <sect1 id="versioning">
     <title>Versioning</title>
     <para></para>
@@ -987,7 +1017,7 @@ import Text.HTML.Internals -- The non-abstract library
 -- Stability   :  experimental | provisional | stable
 -- Portability :  portable | non-portable (<replaceable>reason(s)</replaceable>)
 --
--- $Id: libraries.sgml,v 1.5 2001/08/30 13:36:00 simonmar Exp $
+-- $Id: libraries.sgml,v 1.6 2001/12/21 15:07:26 simonmar Exp $
 --
 -- <replaceable>Description</replaceable>
 -----------------------------------------------------------------------------
@@ -997,7 +1027,7 @@ import Text.HTML.Internals -- The non-abstract library
 
       <variablelist>
        <varlistentry>
-         <term><literal>$Id: libraries.sgml,v 1.5 2001/08/30 13:36:00 simonmar Exp $</literal></term>
+         <term><literal>$Id: libraries.sgml,v 1.6 2001/12/21 15:07:26 simonmar Exp $</literal></term>
          <listitem>
            <para>is optional, but usually included if the module is
            under CVS or RCS control.</para>
@@ -1393,6 +1423,7 @@ e.g. <literal>fromInteger</literal>.</para>
 
     Numeric -> Numeric
        added showHex, showOct, showBin & showIntAtBase from NumExts,
+       (not exported yet - these aren't H98)
        but left out floatToDouble & doubleToFloat (realToFrac is more general).
 
     System    -> System.Exit, System.Environment, System.Cmd
@@ -1405,6 +1436,7 @@ e.g. <literal>fromInteger</literal>.</para>
     Directory -> System.IO.Directory
     Ix        -> Data.Ix
     Locale    -> System.Locale
+    Maybe     -> Data.Maybe
     Monad     -> Data.Monad
     Random    -> System.Random
     Ratio     -> Data.Ratio
index b2d5c3e..9827d9d 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: CTypes.h,v 1.1 2001/06/28 14:15:04 simonmar Exp $
+ * $Id: CTypes.h,v 1.2 2001/12/21 15:07:26 simonmar Exp $
  *
  * Dirty CPP hackery for CTypes/CTypesISO
  *
@@ -162,53 +162,28 @@ instance RealFloat T where { \
 
 #else /* __GLASGOW_HASKELL__ */
 
-/* On GHC, we just cast the type of each method to the underlying
- * type.  This means that GHC only needs to generate the dictionary
- * for each instance, rather than a new function for each method (the
- * simplifier currently isn't clever enough to reduce a method that
- * simply deconstructs a newtype and calls the underlying method into
- * an indirection to the underlying method, so that's what we're doing
- * here). 
+/* GHC can derive any class for a newtype, so we make use of that
+ * here...
  */
 
+#define NUMERIC_CLASSES  Eq,Ord,Num,Enum
+#define INTEGRAL_CLASSES Bounded,Real,Integral,Bits
+#define FLOATING_CLASSES Real,Fractional,Floating,RealFrac,RealFloat
+
 #define NUMERIC_TYPE(T,C,S,B) \
-newtype T = T B ; \
-INSTANCE_EQ(T,B) ; \
-INSTANCE_ORD(T,B) ; \
-INSTANCE_NUM(T,B) ; \
-INSTANCE_READ(T,B) ; \
-INSTANCE_SHOW(T,B) ; \
-INSTANCE_ENUM(T,B) 
+newtype T = T B deriving (NUMERIC_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B)
 
 #define INTEGRAL_TYPE(T,C,S,B) \
-NUMERIC_TYPE(T,C,S,B) ;  \
-INSTANCE_BOUNDED(T,B) ; \
-INSTANCE_REAL(T,B) ; \
-INSTANCE_INTEGRAL(T,B) ; \
-INSTANCE_BITS(T,B)
+newtype T = T B deriving (NUMERIC_CLASSES, INTEGRAL_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B)
 
 #define FLOATING_TYPE(T,C,S,B) \
-NUMERIC_TYPE(T,C,S,B) ; \
-INSTANCE_REAL(T,B) ; \
-INSTANCE_FRACTIONAL(T,B) ; \
-INSTANCE_FLOATING(T,B) ; \
-INSTANCE_REALFRAC(T) ; \
-INSTANCE_REALFLOAT(T,B)
-
-#define INSTANCE_EQ(T,B) \
-instance Eq T where { \
-   (==)                = unsafeCoerce# ((==) :: B -> B -> Bool); \
-   (/=)                = unsafeCoerce# ((/=) :: B -> B -> Bool); }
-
-#define INSTANCE_ORD(T,B) \
-instance Ord T where { \
-   compare             = unsafeCoerce# (compare :: B -> B -> Ordering); \
-   (<)                 = unsafeCoerce# ((<) :: B -> B -> Bool); \
-   (<=)                        = unsafeCoerce# ((<=) :: B -> B -> Bool); \
-   (>=)                        = unsafeCoerce# ((>=) :: B -> B -> Bool); \
-   (>)                 = unsafeCoerce# ((>) :: B -> B -> Bool); \
-   max                 = unsafeCoerce# (max :: B -> B -> B); \
-   min                 = unsafeCoerce# (min :: B -> B -> B); }
+newtype T = T B deriving (NUMERIC_CLASSES, FLOATING_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B)
 
 #define INSTANCE_READ(T,B) \
 instance Read T where { \
@@ -221,115 +196,4 @@ instance Show T where { \
    show                        = unsafeCoerce# (show :: B -> String); \
    showList            = unsafeCoerce# (showList :: [B] -> ShowS); }
 
-#define INSTANCE_NUM(T,B) \
-instance Num T where { \
-   (+)                 = unsafeCoerce# ((+) :: B -> B -> B); \
-   (-)                 = unsafeCoerce# ((-) :: B -> B -> B); \
-   (*)                 = unsafeCoerce# ((*) :: B -> B -> B); \
-   negate              = unsafeCoerce# (negate :: B -> B); \
-   abs                 = unsafeCoerce# (abs :: B -> B); \
-   signum              = unsafeCoerce# (signum :: B -> B); \
-   fromInteger         = unsafeCoerce# (fromInteger :: Integer -> B); }
-
-#define INSTANCE_BOUNDED(T,B) \
-instance Bounded T where { \
-   minBound = T minBound ; \
-   maxBound = T maxBound }
-
-#define INSTANCE_ENUM(T,B) \
-instance Enum T where { \
-    succ               = unsafeCoerce# (succ :: B -> B); \
-    pred               = unsafeCoerce# (pred :: B -> B); \
-    toEnum              = unsafeCoerce# (toEnum :: Int -> B); \
-    fromEnum            = unsafeCoerce# (fromEnum :: B -> Int); \
-    enumFrom           = unsafeCoerce# (enumFrom :: B -> [B]); \
-    enumFromThen       = unsafeCoerce# (enumFromThen :: B -> B -> [B]); \
-    enumFromTo         = unsafeCoerce# (enumFromTo :: B -> B -> [B]); \
-    enumFromThenTo     = unsafeCoerce# (enumFromThenTo :: B -> B -> B -> [B]);}
-
-#define INSTANCE_REAL(T,B) \
-instance Real T where { \
-   toRational = unsafeCoerce# (toRational :: B -> Rational) }
-
-#define INSTANCE_INTEGRAL(T,B) \
-instance Integral T where { \
-    quot               = unsafeCoerce# (quot:: B -> B -> B); \
-    rem                        = unsafeCoerce# (rem:: B -> B -> B); \
-    div                        = unsafeCoerce# (div:: B -> B -> B); \
-    mod                        = unsafeCoerce# (mod:: B -> B -> B); \
-    quotRem            = unsafeCoerce# (quotRem:: B -> B -> (B,B)); \
-    divMod             = unsafeCoerce# (divMod:: B -> B -> (B,B)); \
-    toInteger          = unsafeCoerce# (toInteger:: B -> Integer); }
-
-#define INSTANCE_BITS(T,B) \
-instance Bits T where { \
-  (.&.)                        = unsafeCoerce# ((.&.) :: B -> B -> B); \
-  (.|.)                        = unsafeCoerce# ((.|.) :: B -> B -> B); \
-  xor                  = unsafeCoerce# (xor:: B -> B -> B); \
-  complement           = unsafeCoerce# (complement:: B -> B); \
-  shift                = unsafeCoerce# (shift:: B -> Int -> B); \
-  rotate               = unsafeCoerce# (rotate:: B -> Int -> B); \
-  bit                  = unsafeCoerce# (bit:: Int -> B); \
-  setBit               = unsafeCoerce# (setBit:: B -> Int -> B); \
-  clearBit             = unsafeCoerce# (clearBit:: B -> Int -> B); \
-  complementBit        = unsafeCoerce# (complementBit:: B -> Int -> B); \
-  testBit              = unsafeCoerce# (testBit:: B -> Int -> Bool); \
-  bitSize              = unsafeCoerce# (bitSize:: B -> Int); \
-  isSigned             = unsafeCoerce# (isSigned:: B -> Bool); }
-
-#define INSTANCE_FRACTIONAL(T,B) \
-instance Fractional T where { \
-    (/)                        = unsafeCoerce# ((/) :: B -> B -> B); \
-    recip              = unsafeCoerce# (recip :: B -> B); \
-    fromRational       = unsafeCoerce# (fromRational :: Rational -> B); }
-
-#define INSTANCE_FLOATING(T,B) \
-instance Floating T where { \
-    pi                 = unsafeCoerce# (pi :: B); \
-    exp                        = unsafeCoerce# (exp :: B -> B); \
-    log                        = unsafeCoerce# (log :: B -> B); \
-    sqrt               = unsafeCoerce# (sqrt :: B -> B); \
-    (**)               = unsafeCoerce# ((**) :: B -> B -> B); \
-    logBase            = unsafeCoerce# (logBase :: B -> B -> B); \
-    sin                        = unsafeCoerce# (sin :: B -> B); \
-    cos                        = unsafeCoerce# (cos :: B -> B); \
-    tan                        = unsafeCoerce# (tan :: B -> B); \
-    asin               = unsafeCoerce# (asin :: B -> B); \
-    acos               = unsafeCoerce# (acos :: B -> B); \
-    atan               = unsafeCoerce# (atan :: B -> B); \
-    sinh               = unsafeCoerce# (sinh :: B -> B); \
-    cosh               = unsafeCoerce# (cosh :: B -> B); \
-    tanh               = unsafeCoerce# (tanh :: B -> B); \
-    asinh              = unsafeCoerce# (asinh :: B -> B); \
-    acosh              = unsafeCoerce# (acosh :: B -> B); \
-    atanh              = unsafeCoerce# (atanh :: B -> B); }
-
-/* The coerce trick doesn't work for RealFrac, these methods are
- * polymorphic and overloaded.
- */
-#define INSTANCE_REALFRAC(T) \
-instance RealFrac T where { \
-   properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \
-   truncate (T x) = truncate x ; \
-   round    (T x) = round x ; \
-   ceiling  (T x) = ceiling x ; \
-   floor    (T x) = floor x }
-
-#define INSTANCE_REALFLOAT(T,B) \
-instance RealFloat T where { \
-    floatRadix         = unsafeCoerce# (floatRadix :: B -> Integer); \
-    floatDigits                = unsafeCoerce# (floatDigits :: B -> Int); \
-    floatRange         = unsafeCoerce# (floatRange :: B -> (Int,Int)); \
-    decodeFloat                = unsafeCoerce# (decodeFloat :: B -> (Integer,Int)); \
-    encodeFloat                = unsafeCoerce# (encodeFloat :: Integer -> Int -> B); \
-    exponent           = unsafeCoerce# (exponent :: B -> Int); \
-    significand                = unsafeCoerce# (significand :: B -> B); \
-    scaleFloat         = unsafeCoerce# (scaleFloat :: Int -> B -> B); \
-    isNaN              = unsafeCoerce# (isNaN :: B -> Bool); \
-    isInfinite         = unsafeCoerce# (isInfinite :: B -> Bool); \
-    isDenormalized     = unsafeCoerce# (isDenormalized :: B -> Bool); \
-    isNegativeZero     = unsafeCoerce# (isNegativeZero :: B -> Bool); \
-    isIEEE             = unsafeCoerce# (isIEEE :: B -> Bool); \
-    atan2              = unsafeCoerce# (atan2 :: B -> B -> B); }
-
 #endif /* __GLASGOW_HASKELL__ */
index d07e829..3a13197 100644 (file)
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: HsCore.h,v 1.4 2001/09/14 11:25:57 simonmar Exp $
+ * $Id: HsCore.h,v 1.5 2001/12/21 15:07:26 simonmar Exp $
+ *
+ * (c) The University of Glasgow 2001-2002
  *
  * Definitions for package `core' which are visible in Haskell land.
  *
@@ -63,6 +65,9 @@
 #ifdef HAVE_SYS_TIMES_H
 #include <sys/times.h>
 #endif
+#ifdef HAVE_WINSOCK_H
+#include <winsock.h>
+#endif
 
 #if !defined(mingw32_TARGET_OS) && !defined(irix_TARGET_OS)
 # if defined(HAVE_SYS_RESOURCE_H)
 #ifdef HAVE_VFORK_H
 #include <vfork.h>
 #endif
+#include "lockFile.h"
+#include "dirUtils.h"
+#include "errUtils.h"
+#include "PrelIOUtils.h"
 
-extern inline int s_isreg_wrap(m)  { return S_ISREG(m);  }
-extern inline int s_isdir_wrap(m)  { return S_ISDIR(m);  }
-extern inline int s_isfifo_wrap(m) { return S_ISFIFO(m); }
-extern inline int s_isblk_wrap(m)  { return S_ISBLK(m);  }
-extern inline int s_ischr_wrap(m)  { return S_ISCHR(m);  }
-#ifdef S_ISSOCK
-extern inline int s_issock_wrap(m) { return S_ISSOCK(m); }
+#ifdef _WIN32
+#include <io.h>
+#include <fcntl.h>
 #endif
 
-extern inline void *
-memcpy_wrap_dst_off(char *dst, int dst_off, char *src, size_t sz)
-{ return memcpy(dst+dst_off, src, sz); }
+/* in ghc_errno.c */
+int *ghcErrno(void);
 
-extern inline void *
-memcpy_wrap_src_off(char *dst, char *src, int src_off, size_t sz)
-{ return memcpy(dst, src+src_off, sz); }
+/* in system.c */
+HsInt systemCmd(HsAddr cmd);
 
-extern inline int
-read_ba_wrap(int fd, void *ptr, HsInt off, int size)
-{ return read(fd, ptr + off, size); }
+/* in inputReady.c */
+int inputReady(int fd, int msecs, int isSock);
 
-extern inline int
-write_wrap(int fd, void *ptr, HsInt off, int size)
-{ return write(fd, ptr + off, size); }
+/* -----------------------------------------------------------------------------
+   INLINE functions.
 
-extern inline int
-read_wrap(int fd, void *ptr, HsInt off, int size)
-{ return read(fd, ptr + off, size); }
+   These functions are given as inlines here for when compiling via C,
+   but we also generate static versions into the cbits library for
+   when compiling to native code.
+   -------------------------------------------------------------------------- */
 
-#include "lockFile.h"
+#ifndef INLINE
+#define INLINE extern inline
+#endif
 
-#include "HsFFI.h"
+INLINE int __hscore_s_isreg(m)  { return S_ISREG(m);  }
+INLINE int __hscore_s_isdir(m)  { return S_ISDIR(m);  }
+INLINE int __hscore_s_isfifo(m) { return S_ISFIFO(m); }
+INLINE int __hscore_s_isblk(m)  { return S_ISBLK(m);  }
+INLINE int __hscore_s_ischr(m)  { return S_ISCHR(m);  }
+#ifdef S_ISSOCK
+INLINE int __hscore_s_issock(m) { return S_ISSOCK(m); }
+#endif
 
-/* in ghc_errno.c */
-int *ghcErrno(void);
+INLINE void
+__hscore_sigemptyset( sigset_t *set )
+{ sigemptyset(set); }
 
-/* in system.c */
-HsInt systemCmd(HsAddr cmd);
+INLINE void *
+__hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz )
+{ return memcpy(dst+dst_off, src, sz); }
 
-/* in inputReady.c */
-int inputReady(int fd, int msecs);
+INLINE void *
+__hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz )
+{ return memcpy(dst, src+src_off, sz); }
+
+INLINE HsBool
+__hscore_supportsTextMode()
+{
+#if defined(mingw32_TARGET_OS)
+  return HS_BOOL_FALSE;
+#else
+  return HS_BOOL_TRUE;
+#endif
+}
+
+INLINE HsInt
+__hscore_bufsiz()
+{
+  return BUFSIZ;
+}
+
+INLINE HsInt
+__hscore_seek_cur()
+{
+  return SEEK_CUR;
+}
+
+INLINE HsInt
+__hscore_o_binary()
+{
+#ifdef HAVE_O_BINARY
+  return O_BINARY;
+#else
+  return 0;
+#endif
+}
+
+INLINE HsInt
+__hscore_seek_set()
+{
+  return SEEK_SET;
+}
+
+INLINE HsInt
+__hscore_seek_end()
+{
+  return SEEK_END;
+}
+
+INLINE HsInt
+__hscore_setmode( HsInt fd, HsBool toBin )
+{
+#ifdef _WIN32
+  return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);
+#else
+  return 0;
+#endif  
+}
+
+INLINE HsInt
+__hscore_PrelHandle_write( HsInt fd, HsBool isSock, HsAddr ptr, 
+                          HsInt off, int sz )
+{
+#ifdef _WIN32
+  if (isSock) {
+    return send(fd,ptr + off, sz, 0);
+  }
+#endif
+  return write(fd,ptr + off, sz);
+}
+
+INLINE HsInt
+__hscore_PrelHandle_read( HsInt fd, HsBool isSock, HsAddr ptr, 
+                         HsInt off, int sz )
+{
+#ifdef _WIN32
+  if (isSock) {
+    return recv(fd,ptr + off, sz, 0);
+  }
+#endif
+  return read(fd,ptr + off, sz);
+
+}
 
 #endif
+
diff --git a/include/PackedString.h b/include/PackedString.h
deleted file mode 100644 (file)
index a0fc830..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-/* -----------------------------------------------------------------------------
- * $Id: PackedString.h,v 1.1 2001/06/28 14:15:04 simonmar Exp $
- *
- * C Definitions for PackedString.hs
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PACKEDSTRING_H
-#define PACKEDSTRING_H
-
-/* PackedString.c */
-extern StgInt byteArrayHasNUL__ (StgByteArray ba, StgInt len);
-
-#endif
diff --git a/include/PrelIOUtils.h b/include/PrelIOUtils.h
new file mode 100644 (file)
index 0000000..d7b982f
--- /dev/null
@@ -0,0 +1,40 @@
+/* 
+ * (c) The University of Glasgow 2001-2002
+ *
+ * IO / Handle support.
+ */
+#ifndef __PRELIOUTILS_H__
+#define __PRELIOUTILS_H__
+
+/* PrelIOUtils.c */
+extern HsBool prel_supportsTextMode();
+extern HsInt  prel_bufsiz();
+extern HsInt prel_seek_cur();
+extern HsInt prel_seek_set();
+extern HsInt prel_seek_end();
+
+extern HsInt prel_o_binary();
+
+extern HsInt prel_setmode(HsInt fd, HsBool isBin);
+
+extern HsInt prel_PrelHandle_write(HsInt fd, HsBool isSock, HsAddr ptr, HsInt off, int sz);
+extern HsInt prel_PrelHandle_read(HsInt fd, HsBool isSock, HsAddr ptr, HsInt off, int sz);
+
+extern void* prel_PrelIO_memcpy(char *dst, HsInt dst_off, const char *src, size_t sz);
+
+/* writeError.c */
+extern void writeErrString__(HsAddr msg_hdr, HsAddr msg, HsInt len);
+
+extern int s_isreg_PrelPosix_wrap(int);
+extern int s_isdir_PrelPosix_wrap(int);
+extern int s_isfifo_PrelPosix_wrap(int);
+extern int s_isblk_PrelPosix_wrap(int);
+extern int s_ischr_PrelPosix_wrap(int);
+#ifndef mingw32_TARGET_OS
+extern int s_issock_PrelPosix_wrap(int);
+extern void sigemptyset_PrelPosix_wrap(sigset_t *set);
+#endif
+
+
+#endif /* __PRELIOUTILS_H__ */
+
diff --git a/include/dirUtils.h b/include/dirUtils.h
new file mode 100644 (file)
index 0000000..5be0657
--- /dev/null
@@ -0,0 +1,38 @@
+/* 
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-
+ *
+ * Directory Runtime Support - prototypes.
+ */
+#ifndef __DIRUTILS_H__
+#define __DIRUTILS_H__
+
+#include <sys/stat.h>
+#include <dirent.h>
+#include <limits.h>
+#include <errno.h>
+#include <unistd.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();
+
+#endif /* __DIRUTILS_H__ */
diff --git a/include/errUtils.h b/include/errUtils.h
new file mode 100644 (file)
index 0000000..0578e98
--- /dev/null
@@ -0,0 +1,110 @@
+/* 
+ * (c) The University of Glasgow, 2000-2002
+ *
+ * GHC Error Number Conversion - prototypes.
+ */
+#ifndef __ERRUTILS_H__
+#define __ERRUTILS_H__
+
+#define ErrCodeProto(x) extern HsInt prel_error_##x()
+
+ErrCodeProto(E2BIG);
+ErrCodeProto(EACCES);
+ErrCodeProto(EADDRINUSE);
+ErrCodeProto(EADDRNOTAVAIL);
+ErrCodeProto(EADV);
+ErrCodeProto(EAFNOSUPPORT);
+ErrCodeProto(EAGAIN);
+ErrCodeProto(EALREADY);
+ErrCodeProto(EBADF);
+ErrCodeProto(EBADMSG);
+ErrCodeProto(EBADRPC);
+ErrCodeProto(EBUSY);
+ErrCodeProto(ECHILD);
+ErrCodeProto(ECOMM);
+ErrCodeProto(ECONNABORTED);
+ErrCodeProto(ECONNREFUSED);
+ErrCodeProto(ECONNRESET);
+ErrCodeProto(EDEADLK);
+ErrCodeProto(EDESTADDRREQ);
+ErrCodeProto(EDIRTY);
+ErrCodeProto(EDOM);
+ErrCodeProto(EDQUOT);
+ErrCodeProto(EEXIST);
+ErrCodeProto(EFAULT);
+ErrCodeProto(EFBIG);
+ErrCodeProto(EFTYPE);
+ErrCodeProto(EHOSTDOWN);
+ErrCodeProto(EHOSTUNREACH);
+ErrCodeProto(EIDRM);
+ErrCodeProto(EILSEQ);
+ErrCodeProto(EINPROGRESS);
+ErrCodeProto(EINTR);
+ErrCodeProto(EINVAL);
+ErrCodeProto(EIO);
+ErrCodeProto(EISCONN);
+ErrCodeProto(EISDIR);
+ErrCodeProto(ELOOP);
+ErrCodeProto(EMFILE);
+ErrCodeProto(EMLINK);
+ErrCodeProto(EMSGSIZE);
+ErrCodeProto(EMULTIHOP);
+ErrCodeProto(ENAMETOOLONG);
+ErrCodeProto(ENETDOWN);
+ErrCodeProto(ENETRESET);
+ErrCodeProto(ENETUNREACH);
+ErrCodeProto(ENFILE);
+ErrCodeProto(ENOBUFS);
+ErrCodeProto(ENODATA);
+ErrCodeProto(ENODEV);
+ErrCodeProto(ENOENT);
+ErrCodeProto(ENOEXEC);
+ErrCodeProto(ENOLCK);
+ErrCodeProto(ENOLINK);
+ErrCodeProto(ENOMEM);
+ErrCodeProto(ENOMSG);
+ErrCodeProto(ENONET);
+ErrCodeProto(ENOPROTOOPT);
+ErrCodeProto(ENOSPC);
+ErrCodeProto(ENOSR);
+ErrCodeProto(ENOSTR);
+ErrCodeProto(ENOSYS);
+ErrCodeProto(ENOTBLK);
+ErrCodeProto(ENOTCONN);
+ErrCodeProto(ENOTDIR);
+ErrCodeProto(ENOTEMPTY);
+ErrCodeProto(ENOTSOCK);
+ErrCodeProto(ENOTTY);
+ErrCodeProto(ENXIO);
+ErrCodeProto(EOPNOTSUPP);
+ErrCodeProto(EPERM);
+ErrCodeProto(EPFNOSUPPORT);
+ErrCodeProto(EPIPE);
+ErrCodeProto(EPROCLIM);
+ErrCodeProto(EPROCUNAVAIL);
+ErrCodeProto(EPROGMISMATCH);
+ErrCodeProto(EPROGUNAVAIL);
+ErrCodeProto(EPROTO);
+ErrCodeProto(EPROTONOSUPPORT);
+ErrCodeProto(EPROTOTYPE);
+ErrCodeProto(ERANGE);
+ErrCodeProto(EREMCHG);
+ErrCodeProto(EREMOTE);
+ErrCodeProto(EROFS);
+ErrCodeProto(ERPCMISMATCH);
+ErrCodeProto(ERREMOTE);
+ErrCodeProto(ESHUTDOWN);
+ErrCodeProto(ESOCKTNOSUPPORT);
+ErrCodeProto(ESPIPE);
+ErrCodeProto(ESRCH);
+ErrCodeProto(ESRMNT);
+ErrCodeProto(ESTALE);
+ErrCodeProto(ETIME);
+ErrCodeProto(ETIMEDOUT);
+ErrCodeProto(ETOOMANYREFS);
+ErrCodeProto(ETXTBSY);
+ErrCodeProto(EUSERS);
+ErrCodeProto(EWOULDBLOCK);
+ErrCodeProto(EXDEV);
+
+#endif /* __ERRUTILS_H__ */