Commit aadbf091 authored by simonmar's avatar simonmar
Browse files

[project @ 2002-02-05 17:32:24 by simonmar]

- Merging from ghc/lib/std
- Add System.IO.Error
- Now builds without --make, so we can do -split-objs
parent ec3d22de
......@@ -8,7 +8,7 @@
-- Stability : experimental
-- Portability : non-portable
--
-- $Id: Exception.hs,v 1.5 2001/12/21 15:07:21 simonmar Exp $
-- $Id: Exception.hs,v 1.6 2002/02/05 17:32:25 simonmar Exp $
--
-- The External API for exceptions. The functions provided in this
-- module allow catching of exceptions in the IO monad.
......@@ -76,6 +76,7 @@ module Control.Exception (
#ifdef __GLASGOW_HASKELL__
import Prelude hiding (catch)
import System.IO.Error
import GHC.Base ( assert )
import GHC.Exception hiding (try, catch, bracket, bracket_)
import GHC.Conc ( throwTo, ThreadId )
......@@ -199,7 +200,7 @@ dynExceptions _ = Nothing
asyncExceptions (AsyncException e) = Just e
asyncExceptions _ = Nothing
userErrors (UserError e) = Just e
userErrors e | isUserError e = Just (ioeGetErrorString e)
userErrors _ = Nothing
-----------------------------------------------------------------------------
......
......@@ -9,7 +9,7 @@
-- Stability : experimental
-- Portability : non-portable
--
-- $Id: IO.hs,v 1.3 2002/01/02 14:40:10 simonmar Exp $
-- $Id: IO.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
--
-- Mutable boxed/unboxed arrays in the IO monad.
--
......@@ -407,7 +407,7 @@ readChunk fd is_stream ptr init_off bytes = loop init_off bytes
loop off bytes | bytes <= 0 = return (off - init_off)
loop off bytes = do
r' <- throwErrnoIfMinus1RetryMayBlock "readChunk"
(read_off (fromIntegral fd) is_stream ptr
(read_off_ba (fromIntegral fd) is_stream ptr
(fromIntegral off) (fromIntegral bytes))
(threadWaitRead fd)
let r = fromIntegral r'
......
......@@ -9,7 +9,7 @@
-- Stability : experimental
-- Portability : portable
--
-- $Id: Bits.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $
-- $Id: Bits.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
--
-- Bitwise operations.
--
......@@ -50,7 +50,7 @@ import GHC.Base
-- Removing all fixities is a fairly safe fix; fixing the "one fixity
-- per symbol per program" limitation in Hugs would take a lot longer.
#ifndef __HUGS__
infixl 8 `shift`, `rotate`
infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
infixl 7 .&.
infixl 6 `xor`
infixl 5 .|.
......
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Error.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
-- $Id: Error.hs,v 1.5 2002/02/05 17:32:25 simonmar Exp $
--
-- C-specific Marshalling support: Handling of C "errno" error codes
--
......@@ -121,7 +121,7 @@ import System.IO ( IOError, Handle, ioError )
-- This function exists because errno is a variable on some systems, but on
-- Windows it is a macro for a function...
-- [yes, global variables and thread safety don't really go hand-in-hand. -- sof]
foreign import "ghcErrno" unsafe _errno :: Ptr CInt
foreign import ccall unsafe "ghcErrno" _errno :: Ptr CInt
-- Haskell representation for "errno" values
--
......@@ -513,107 +513,107 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
#endif
foreign import unsafe strerror :: Errno -> IO (Ptr CChar)
foreign import ccall unsafe strerror :: Errno -> IO (Ptr CChar)
-- Dreadfully tedious callouts to wrappers which define the
-- actual values for the error codes.
foreign import ccall "prel_error_E2BIG" unsafe cCONST_E2BIG :: CInt
foreign import ccall "prel_error_EACCES" unsafe cCONST_EACCES :: CInt
foreign import ccall "prel_error_EADDRINUSE" unsafe cCONST_EADDRINUSE :: CInt
foreign import ccall "prel_error_EADDRNOTAVAIL" unsafe cCONST_EADDRNOTAVAIL :: CInt
foreign import ccall "prel_error_EADV" unsafe cCONST_EADV :: CInt
foreign import ccall "prel_error_EAFNOSUPPORT" unsafe cCONST_EAFNOSUPPORT :: CInt
foreign import ccall "prel_error_EAGAIN" unsafe cCONST_EAGAIN :: CInt
foreign import ccall "prel_error_EALREADY" unsafe cCONST_EALREADY :: CInt
foreign import ccall "prel_error_EBADF" unsafe cCONST_EBADF :: CInt
foreign import ccall "prel_error_EBADMSG" unsafe cCONST_EBADMSG :: CInt
foreign import ccall "prel_error_EBADRPC" unsafe cCONST_EBADRPC :: CInt
foreign import ccall "prel_error_EBUSY" unsafe cCONST_EBUSY :: CInt
foreign import ccall "prel_error_ECHILD" unsafe cCONST_ECHILD :: CInt
foreign import ccall "prel_error_ECOMM" unsafe cCONST_ECOMM :: CInt
foreign import ccall "prel_error_ECONNABORTED" unsafe cCONST_ECONNABORTED :: CInt
foreign import ccall "prel_error_ECONNREFUSED" unsafe cCONST_ECONNREFUSED :: CInt
foreign import ccall "prel_error_ECONNRESET" unsafe cCONST_ECONNRESET :: CInt
foreign import ccall "prel_error_EDEADLK" unsafe cCONST_EDEADLK :: CInt
foreign import ccall "prel_error_EDESTADDRREQ" unsafe cCONST_EDESTADDRREQ :: CInt
foreign import ccall "prel_error_EDIRTY" unsafe cCONST_EDIRTY :: CInt
foreign import ccall "prel_error_EDOM" unsafe cCONST_EDOM :: CInt
foreign import ccall "prel_error_EDQUOT" unsafe cCONST_EDQUOT :: CInt
foreign import ccall "prel_error_EEXIST" unsafe cCONST_EEXIST :: CInt
foreign import ccall "prel_error_EFAULT" unsafe cCONST_EFAULT :: CInt
foreign import ccall "prel_error_EFBIG" unsafe cCONST_EFBIG :: CInt
foreign import ccall "prel_error_EFTYPE" unsafe cCONST_EFTYPE :: CInt
foreign import ccall "prel_error_EHOSTDOWN" unsafe cCONST_EHOSTDOWN :: CInt
foreign import ccall "prel_error_EHOSTUNREACH" unsafe cCONST_EHOSTUNREACH :: CInt
foreign import ccall "prel_error_EIDRM" unsafe cCONST_EIDRM :: CInt
foreign import ccall "prel_error_EILSEQ" unsafe cCONST_EILSEQ :: CInt
foreign import ccall "prel_error_EINPROGRESS" unsafe cCONST_EINPROGRESS :: CInt
foreign import ccall "prel_error_EINTR" unsafe cCONST_EINTR :: CInt
foreign import ccall "prel_error_EINVAL" unsafe cCONST_EINVAL :: CInt
foreign import ccall "prel_error_EIO" unsafe cCONST_EIO :: CInt
foreign import ccall "prel_error_EISCONN" unsafe cCONST_EISCONN :: CInt
foreign import ccall "prel_error_EISDIR" unsafe cCONST_EISDIR :: CInt
foreign import ccall "prel_error_ELOOP" unsafe cCONST_ELOOP :: CInt
foreign import ccall "prel_error_EMFILE" unsafe cCONST_EMFILE :: CInt
foreign import ccall "prel_error_EMLINK" unsafe cCONST_EMLINK :: CInt
foreign import ccall "prel_error_EMSGSIZE" unsafe cCONST_EMSGSIZE :: CInt
foreign import ccall "prel_error_EMULTIHOP" unsafe cCONST_EMULTIHOP :: CInt
foreign import ccall "prel_error_ENAMETOOLONG" unsafe cCONST_ENAMETOOLONG :: CInt
foreign import ccall "prel_error_ENETDOWN" unsafe cCONST_ENETDOWN :: CInt
foreign import ccall "prel_error_ENETRESET" unsafe cCONST_ENETRESET :: CInt
foreign import ccall "prel_error_ENETUNREACH" unsafe cCONST_ENETUNREACH :: CInt
foreign import ccall "prel_error_ENFILE" unsafe cCONST_ENFILE :: CInt
foreign import ccall "prel_error_ENOBUFS" unsafe cCONST_ENOBUFS :: CInt
foreign import ccall "prel_error_ENODATA" unsafe cCONST_ENODATA :: CInt
foreign import ccall "prel_error_ENODEV" unsafe cCONST_ENODEV :: CInt
foreign import ccall "prel_error_ENOENT" unsafe cCONST_ENOENT :: CInt
foreign import ccall "prel_error_ENOEXEC" unsafe cCONST_ENOEXEC :: CInt
foreign import ccall "prel_error_ENOLCK" unsafe cCONST_ENOLCK :: CInt
foreign import ccall "prel_error_ENOLINK" unsafe cCONST_ENOLINK :: CInt
foreign import ccall "prel_error_ENOMEM" unsafe cCONST_ENOMEM :: CInt
foreign import ccall "prel_error_ENOMSG" unsafe cCONST_ENOMSG :: CInt
foreign import ccall "prel_error_ENONET" unsafe cCONST_ENONET :: CInt
foreign import ccall "prel_error_ENOPROTOOPT" unsafe cCONST_ENOPROTOOPT :: CInt
foreign import ccall "prel_error_ENOSPC" unsafe cCONST_ENOSPC :: CInt
foreign import ccall "prel_error_ENOSR" unsafe cCONST_ENOSR :: CInt
foreign import ccall "prel_error_ENOSTR" unsafe cCONST_ENOSTR :: CInt
foreign import ccall "prel_error_ENOSYS" unsafe cCONST_ENOSYS :: CInt
foreign import ccall "prel_error_ENOTBLK" unsafe cCONST_ENOTBLK :: CInt
foreign import ccall "prel_error_ENOTCONN" unsafe cCONST_ENOTCONN :: CInt
foreign import ccall "prel_error_ENOTDIR" unsafe cCONST_ENOTDIR :: CInt
foreign import ccall "prel_error_ENOTEMPTY" unsafe cCONST_ENOTEMPTY :: CInt
foreign import ccall "prel_error_ENOTSOCK" unsafe cCONST_ENOTSOCK :: CInt
foreign import ccall "prel_error_ENOTTY" unsafe cCONST_ENOTTY :: CInt
foreign import ccall "prel_error_ENXIO" unsafe cCONST_ENXIO :: CInt
foreign import ccall "prel_error_EOPNOTSUPP" unsafe cCONST_EOPNOTSUPP :: CInt
foreign import ccall "prel_error_EPERM" unsafe cCONST_EPERM :: CInt
foreign import ccall "prel_error_EPFNOSUPPORT" unsafe cCONST_EPFNOSUPPORT :: CInt
foreign import ccall "prel_error_EPIPE" unsafe cCONST_EPIPE :: CInt
foreign import ccall "prel_error_EPROCLIM" unsafe cCONST_EPROCLIM :: CInt
foreign import ccall "prel_error_EPROCUNAVAIL" unsafe cCONST_EPROCUNAVAIL :: CInt
foreign import ccall "prel_error_EPROGMISMATCH" unsafe cCONST_EPROGMISMATCH :: CInt
foreign import ccall "prel_error_EPROGUNAVAIL" unsafe cCONST_EPROGUNAVAIL :: CInt
foreign import ccall "prel_error_EPROTO" unsafe cCONST_EPROTO :: CInt
foreign import ccall "prel_error_EPROTONOSUPPORT" unsafe cCONST_EPROTONOSUPPORT :: CInt
foreign import ccall "prel_error_EPROTOTYPE" unsafe cCONST_EPROTOTYPE :: CInt
foreign import ccall "prel_error_ERANGE" unsafe cCONST_ERANGE :: CInt
foreign import ccall "prel_error_EREMCHG" unsafe cCONST_EREMCHG :: CInt
foreign import ccall "prel_error_EREMOTE" unsafe cCONST_EREMOTE :: CInt
foreign import ccall "prel_error_EROFS" unsafe cCONST_EROFS :: CInt
foreign import ccall "prel_error_ERPCMISMATCH" unsafe cCONST_ERPCMISMATCH :: CInt
foreign import ccall "prel_error_ERREMOTE" unsafe cCONST_ERREMOTE :: CInt
foreign import ccall "prel_error_ESHUTDOWN" unsafe cCONST_ESHUTDOWN :: CInt
foreign import ccall "prel_error_ESOCKTNOSUPPORT" unsafe cCONST_ESOCKTNOSUPPORT :: CInt
foreign import ccall "prel_error_ESPIPE" unsafe cCONST_ESPIPE :: CInt
foreign import ccall "prel_error_ESRCH" unsafe cCONST_ESRCH :: CInt
foreign import ccall "prel_error_ESRMNT" unsafe cCONST_ESRMNT :: CInt
foreign import ccall "prel_error_ESTALE" unsafe cCONST_ESTALE :: CInt
foreign import ccall "prel_error_ETIME" unsafe cCONST_ETIME :: CInt
foreign import ccall "prel_error_ETIMEDOUT" unsafe cCONST_ETIMEDOUT :: CInt
foreign import ccall "prel_error_ETOOMANYREFS" unsafe cCONST_ETOOMANYREFS :: CInt
foreign import ccall "prel_error_ETXTBSY" unsafe cCONST_ETXTBSY :: CInt
foreign import ccall "prel_error_EUSERS" unsafe cCONST_EUSERS :: CInt
foreign import ccall "prel_error_EWOULDBLOCK" unsafe cCONST_EWOULDBLOCK :: CInt
foreign import ccall "prel_error_EXDEV" unsafe cCONST_EXDEV :: CInt
foreign import ccall unsafe "prel_error_E2BIG" cCONST_E2BIG :: CInt
foreign import ccall unsafe "prel_error_EACCES" cCONST_EACCES :: CInt
foreign import ccall unsafe "prel_error_EADDRINUSE" cCONST_EADDRINUSE :: CInt
foreign import ccall unsafe "prel_error_EADDRNOTAVAIL" cCONST_EADDRNOTAVAIL :: CInt
foreign import ccall unsafe "prel_error_EADV" cCONST_EADV :: CInt
foreign import ccall unsafe "prel_error_EAFNOSUPPORT" cCONST_EAFNOSUPPORT :: CInt
foreign import ccall unsafe "prel_error_EAGAIN" cCONST_EAGAIN :: CInt
foreign import ccall unsafe "prel_error_EALREADY" cCONST_EALREADY :: CInt
foreign import ccall unsafe "prel_error_EBADF" cCONST_EBADF :: CInt
foreign import ccall unsafe "prel_error_EBADMSG" cCONST_EBADMSG :: CInt
foreign import ccall unsafe "prel_error_EBADRPC" cCONST_EBADRPC :: CInt
foreign import ccall unsafe "prel_error_EBUSY" cCONST_EBUSY :: CInt
foreign import ccall unsafe "prel_error_ECHILD" cCONST_ECHILD :: CInt
foreign import ccall unsafe "prel_error_ECOMM" cCONST_ECOMM :: CInt
foreign import ccall unsafe "prel_error_ECONNABORTED" cCONST_ECONNABORTED :: CInt
foreign import ccall unsafe "prel_error_ECONNREFUSED" cCONST_ECONNREFUSED :: CInt
foreign import ccall unsafe "prel_error_ECONNRESET" cCONST_ECONNRESET :: CInt
foreign import ccall unsafe "prel_error_EDEADLK" cCONST_EDEADLK :: CInt
foreign import ccall unsafe "prel_error_EDESTADDRREQ" cCONST_EDESTADDRREQ :: CInt
foreign import ccall unsafe "prel_error_EDIRTY" cCONST_EDIRTY :: CInt
foreign import ccall unsafe "prel_error_EDOM" cCONST_EDOM :: CInt
foreign import ccall unsafe "prel_error_EDQUOT" cCONST_EDQUOT :: CInt
foreign import ccall unsafe "prel_error_EEXIST" cCONST_EEXIST :: CInt
foreign import ccall unsafe "prel_error_EFAULT" cCONST_EFAULT :: CInt
foreign import ccall unsafe "prel_error_EFBIG" cCONST_EFBIG :: CInt
foreign import ccall unsafe "prel_error_EFTYPE" cCONST_EFTYPE :: CInt
foreign import ccall unsafe "prel_error_EHOSTDOWN" cCONST_EHOSTDOWN :: CInt
foreign import ccall unsafe "prel_error_EHOSTUNREACH" cCONST_EHOSTUNREACH :: CInt
foreign import ccall unsafe "prel_error_EIDRM" cCONST_EIDRM :: CInt
foreign import ccall unsafe "prel_error_EILSEQ" cCONST_EILSEQ :: CInt
foreign import ccall unsafe "prel_error_EINPROGRESS" cCONST_EINPROGRESS :: CInt
foreign import ccall unsafe "prel_error_EINTR" cCONST_EINTR :: CInt
foreign import ccall unsafe "prel_error_EINVAL" cCONST_EINVAL :: CInt
foreign import ccall unsafe "prel_error_EIO" cCONST_EIO :: CInt
foreign import ccall unsafe "prel_error_EISCONN" cCONST_EISCONN :: CInt
foreign import ccall unsafe "prel_error_EISDIR" cCONST_EISDIR :: CInt
foreign import ccall unsafe "prel_error_ELOOP" cCONST_ELOOP :: CInt
foreign import ccall unsafe "prel_error_EMFILE" cCONST_EMFILE :: CInt
foreign import ccall unsafe "prel_error_EMLINK" cCONST_EMLINK :: CInt
foreign import ccall unsafe "prel_error_EMSGSIZE" cCONST_EMSGSIZE :: CInt
foreign import ccall unsafe "prel_error_EMULTIHOP" cCONST_EMULTIHOP :: CInt
foreign import ccall unsafe "prel_error_ENAMETOOLONG" cCONST_ENAMETOOLONG :: CInt
foreign import ccall unsafe "prel_error_ENETDOWN" cCONST_ENETDOWN :: CInt
foreign import ccall unsafe "prel_error_ENETRESET" cCONST_ENETRESET :: CInt
foreign import ccall unsafe "prel_error_ENETUNREACH" cCONST_ENETUNREACH :: CInt
foreign import ccall unsafe "prel_error_ENFILE" cCONST_ENFILE :: CInt
foreign import ccall unsafe "prel_error_ENOBUFS" cCONST_ENOBUFS :: CInt
foreign import ccall unsafe "prel_error_ENODATA" cCONST_ENODATA :: CInt
foreign import ccall unsafe "prel_error_ENODEV" cCONST_ENODEV :: CInt
foreign import ccall unsafe "prel_error_ENOENT" cCONST_ENOENT :: CInt
foreign import ccall unsafe "prel_error_ENOEXEC" cCONST_ENOEXEC :: CInt
foreign import ccall unsafe "prel_error_ENOLCK" cCONST_ENOLCK :: CInt
foreign import ccall unsafe "prel_error_ENOLINK" cCONST_ENOLINK :: CInt
foreign import ccall unsafe "prel_error_ENOMEM" cCONST_ENOMEM :: CInt
foreign import ccall unsafe "prel_error_ENOMSG" cCONST_ENOMSG :: CInt
foreign import ccall unsafe "prel_error_ENONET" cCONST_ENONET :: CInt
foreign import ccall unsafe "prel_error_ENOPROTOOPT" cCONST_ENOPROTOOPT :: CInt
foreign import ccall unsafe "prel_error_ENOSPC" cCONST_ENOSPC :: CInt
foreign import ccall unsafe "prel_error_ENOSR" cCONST_ENOSR :: CInt
foreign import ccall unsafe "prel_error_ENOSTR" cCONST_ENOSTR :: CInt
foreign import ccall unsafe "prel_error_ENOSYS" cCONST_ENOSYS :: CInt
foreign import ccall unsafe "prel_error_ENOTBLK" cCONST_ENOTBLK :: CInt
foreign import ccall unsafe "prel_error_ENOTCONN" cCONST_ENOTCONN :: CInt
foreign import ccall unsafe "prel_error_ENOTDIR" cCONST_ENOTDIR :: CInt
foreign import ccall unsafe "prel_error_ENOTEMPTY" cCONST_ENOTEMPTY :: CInt
foreign import ccall unsafe "prel_error_ENOTSOCK" cCONST_ENOTSOCK :: CInt
foreign import ccall unsafe "prel_error_ENOTTY" cCONST_ENOTTY :: CInt
foreign import ccall unsafe "prel_error_ENXIO" cCONST_ENXIO :: CInt
foreign import ccall unsafe "prel_error_EOPNOTSUPP" cCONST_EOPNOTSUPP :: CInt
foreign import ccall unsafe "prel_error_EPERM" cCONST_EPERM :: CInt
foreign import ccall unsafe "prel_error_EPFNOSUPPORT" cCONST_EPFNOSUPPORT :: CInt
foreign import ccall unsafe "prel_error_EPIPE" cCONST_EPIPE :: CInt
foreign import ccall unsafe "prel_error_EPROCLIM" cCONST_EPROCLIM :: CInt
foreign import ccall unsafe "prel_error_EPROCUNAVAIL" cCONST_EPROCUNAVAIL :: CInt
foreign import ccall unsafe "prel_error_EPROGMISMATCH" cCONST_EPROGMISMATCH :: CInt
foreign import ccall unsafe "prel_error_EPROGUNAVAIL" cCONST_EPROGUNAVAIL :: CInt
foreign import ccall unsafe "prel_error_EPROTO" cCONST_EPROTO :: CInt
foreign import ccall unsafe "prel_error_EPROTONOSUPPORT" cCONST_EPROTONOSUPPORT :: CInt
foreign import ccall unsafe "prel_error_EPROTOTYPE" cCONST_EPROTOTYPE :: CInt
foreign import ccall unsafe "prel_error_ERANGE" cCONST_ERANGE :: CInt
foreign import ccall unsafe "prel_error_EREMCHG" cCONST_EREMCHG :: CInt
foreign import ccall unsafe "prel_error_EREMOTE" cCONST_EREMOTE :: CInt
foreign import ccall unsafe "prel_error_EROFS" cCONST_EROFS :: CInt
foreign import ccall unsafe "prel_error_ERPCMISMATCH" cCONST_ERPCMISMATCH :: CInt
foreign import ccall unsafe "prel_error_ERREMOTE" cCONST_ERREMOTE :: CInt
foreign import ccall unsafe "prel_error_ESHUTDOWN" cCONST_ESHUTDOWN :: CInt
foreign import ccall unsafe "prel_error_ESOCKTNOSUPPORT" cCONST_ESOCKTNOSUPPORT :: CInt
foreign import ccall unsafe "prel_error_ESPIPE" cCONST_ESPIPE :: CInt
foreign import ccall unsafe "prel_error_ESRCH" cCONST_ESRCH :: CInt
foreign import ccall unsafe "prel_error_ESRMNT" cCONST_ESRMNT :: CInt
foreign import ccall unsafe "prel_error_ESTALE" cCONST_ESTALE :: CInt
foreign import ccall unsafe "prel_error_ETIME" cCONST_ETIME :: CInt
foreign import ccall unsafe "prel_error_ETIMEDOUT" cCONST_ETIMEDOUT :: CInt
foreign import ccall unsafe "prel_error_ETOOMANYREFS" cCONST_ETOOMANYREFS :: CInt
foreign import ccall unsafe "prel_error_ETXTBSY" cCONST_ETXTBSY :: CInt
foreign import ccall unsafe "prel_error_EUSERS" cCONST_EUSERS :: CInt
foreign import ccall unsafe "prel_error_EWOULDBLOCK" cCONST_EWOULDBLOCK :: CInt
foreign import ccall unsafe "prel_error_EXDEV" cCONST_EXDEV :: CInt
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Types.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
-- $Id: Types.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
--
-- Mapping of C types to corresponding Haskell types. A cool hack...
--
......@@ -18,13 +18,14 @@
module Foreign.C.Types
( -- Integral types, instances of: Eq, Ord, Num, Read, Show, Enum,
-- Typeable, Storable, Bounded, Real, Integral, Bits
CChar(..), CSChar(..), CUChar(..)
, CShort(..), CUShort(..), CInt(..), CUInt(..)
, CLong(..), CULong(..), CLLong(..), CULLong(..)
CChar(..), CSChar(..), CUChar(..)
, CShort(..), CUShort(..), CInt(..), CUInt(..)
, CLong(..), CULong(..), CLLong(..), CULLong(..)
-- Floating types, instances of: Eq, Ord, Num, Read, Show, Enum,
-- Typeable, Storable, Real, Fractional, Floating, RealFrac, RealFloat
, CFloat(..), CDouble(..), CLDouble(..)
-- Typeable, Storable, Real, Fractional, Floating, RealFrac,
-- RealFloat
, CFloat(..), CDouble(..), CLDouble(..)
) where
import Data.Bits ( Bits(..) )
......
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: TypesISO.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
-- $Id: TypesISO.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
--
-- A mapping of C types defined by the ISO C standard to corresponding Haskell
-- types. Like CTypes, this is a cool hack...
......@@ -25,6 +25,7 @@ module Foreign.C.TypesISO
-- Typeable, Storable
, CClock(..), CTime(..),
-- Instances of: Eq and Storable
, CFile, CFpos, CJmpBuf
) where
......@@ -64,12 +65,9 @@ INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T)
INTEGRAL_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
INTEGRAL_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
-- TODO: Instances. But which...? :-}
-- FIXME: Implement and provide instances for Eq and Storable
data CFile = CFile
data CFpos = CFpos
data CJmpBuf = CJmpBuf
-- C99 types which are still missing include:
......
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Alloc.hs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
-- $Id: Alloc.hs,v 1.5 2002/02/05 17:32:25 simonmar Exp $
--
-- Marshalling support: basic routines for memory allocation
--
......@@ -124,6 +124,6 @@ failWhenNULL name f = do
-- basic C routines needed for memory allocation
--
foreign import "malloc" unsafe _malloc :: CSize -> IO (Ptr a)
foreign import "realloc" unsafe _realloc :: Ptr a -> CSize -> IO (Ptr a)
foreign import "free" unsafe _free :: Ptr a -> IO ()
foreign import ccall unsafe "malloc" _malloc :: CSize -> IO (Ptr a)
foreign import ccall unsafe "realloc" _realloc :: Ptr a -> CSize -> IO (Ptr a)
foreign import ccall unsafe "free" _free :: Ptr a -> IO ()
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Array.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $
-- $Id: Array.hs,v 1.4 2002/02/05 17:32:25 simonmar Exp $
--
-- Marshalling support: routines allocating, storing, and retrieving Haskell
-- lists that are represented as arrays in the foreign language
......@@ -45,11 +45,6 @@ module Foreign.Marshal.Array (
withArray, -- :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray0, -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
-- destruction
--
destructArray, -- :: Storable a => Int -> Ptr a -> IO ()
destructArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO ()
-- copying (argument order: destination, source)
--
copyArray, -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
......@@ -61,14 +56,14 @@ module Foreign.Marshal.Array (
-- indexing
--
advancePtr -- :: Storable a => Ptr a -> Int -> Ptr a
advancePtr, -- :: Storable a => Ptr a -> Int -> Ptr a
) where
import Control.Monad
#ifdef __GLASGOW_HASKELL__
import Foreign.Ptr (Ptr, plusPtr)
import GHC.Storable (Storable(sizeOf,peekElemOff,pokeElemOff,destruct))
import GHC.Storable (Storable(sizeOf,peekElemOff,pokeElemOff))
import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes)
import Foreign.Marshal.Utils (copyBytes, moveBytes)
import GHC.IOBase
......@@ -191,7 +186,6 @@ withArray vals f =
allocaArray len $ \ptr -> do
pokeArray ptr vals
res <- f ptr
destructArray len ptr
return res
where
len = length vals
......@@ -203,31 +197,11 @@ withArray0 marker vals f =
allocaArray0 len $ \ptr -> do
pokeArray0 marker ptr vals
res <- f ptr
destructArray (len+1) ptr
return res
where
len = length vals
-- destruction
-- -----------
-- destruct each element of an array (in reverse order)
--
destructArray :: Storable a => Int -> Ptr a -> IO ()
destructArray size ptr =
sequence_ [destruct (ptr `advancePtr` i)
| i <- [size-1, size-2 .. 0]]
-- like `destructArray', but a terminator indicates where the array ends
--
destructArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO ()
destructArray0 marker ptr = do
size <- lengthArray0 marker ptr
sequence_ [destruct (ptr `advancePtr` i)
| i <- [size, size-1 .. 0]]
-- copying (argument order: destination, source)
-- -------
......
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Utils.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
-- $Id: Utils.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
--
-- Utilities for primitive marshaling
--
......@@ -52,11 +52,11 @@ import Data.Maybe
#ifdef __GLASGOW_HASKELL__
import Foreign.Ptr ( Ptr, nullPtr )
import GHC.Storable ( Storable(poke,destruct) )
import Foreign.C.TypesISO ( CSize )
import Foreign.Marshal.Alloc ( malloc, alloca )
import GHC.Storable ( Storable(poke) )
import Foreign.C.TypesISO ( CSize )
import Foreign.Marshal.Alloc ( malloc, alloca )
import GHC.IOBase
import GHC.Real ( fromIntegral )
import GHC.Real ( fromIntegral )
import GHC.Num
import GHC.Base
#endif
......@@ -83,7 +83,6 @@ withObject val f =
alloca $ \ptr -> do
poke ptr val
res <- f ptr
destruct ptr
return res
......@@ -164,5 +163,5 @@ moveBytes dest src size = memmove dest src (fromIntegral size)
-- basic C routines needed for memory copying
--
foreign import unsafe memcpy :: Ptr a -> Ptr a -> CSize -> IO ()
foreign import unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO ()
foreign import ccall unsafe memcpy :: Ptr a -> Ptr a -> CSize -> IO ()
foreign import ccall unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO ()
......@@ -9,7 +9,7 @@
-- Stability : provisional
-- Portability : portable
--
-- $Id: Storable.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
-- $Id: Storable.hs,v 1.3 2002/02/05 17:32:25 simonmar Exp $
--
-- A class for primitive marshaling
--
......@@ -24,8 +24,7 @@ module Foreign.Storable
peekByteOff, -- :: Ptr b -> Int -> IO a
pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
peek, -- :: Ptr a -> IO a
poke, -- :: Ptr a -> a -> IO ()
destruct) -- :: Ptr a -> IO ()
poke) -- :: Ptr a -> a -> IO ()
) where
#ifdef __GLASGOW_HASKELL__
......
% -----------------------------------------------------------------------------
% $Id: Base.lhs,v 1.4 2001/12/21 15:07:22 simonmar Exp $
% $Id: Base.lhs,v 1.5 2002/02/05 17:32:26 simonmar Exp $
%
% (c) The University of Glasgow, 1992-2000
%
......@@ -272,8 +272,10 @@ augment g xs = g (:) xs
"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
foldr k z (augment g xs) = g k (foldr k z xs)
"foldr/id" foldr (:) [] = \x->x
"foldr/app" forall xs ys. foldr (:) ys xs = append xs ys
"foldr/id" foldr (:) [] = \x->x
"foldr/app" [1] forall xs ys. foldr (:) ys xs = xs ++ ys
-- Only activate this from phase 1, because that's
-- when we disable the rule that expands (++) into foldr
-- The foldr/cons rule looks nice, but it can give disastrously
-- bloated code when commpiling
......@@ -304,21 +306,36 @@ augment g xs = g (:) xs
\begin{code}
map :: (a -> b) -> [a] -> [b]
{-# NOINLINE [1] map #-}
map = mapList
map _ [] = []
map f (x:xs) = f x : map f xs
-- Note eta expanded
mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
{-# INLINE [0] mapFB #-}
mapFB c f x ys = c (f x) ys
mapList :: (a -> b) -> [a] -> [b]
mapList _ [] = []
mapList f (x:xs) = f x : mapList f xs
-- The rules for map work like this.
--
-- Up to (but not including) phase 1, we use the "map" rule to
-- rewrite all saturated applications of map with its build/fold
-- form, hoping for fusion to happen.
-- In phase 1 and 0, we switch off that rule, inline build, and
-- switch on the "mapList" rule, which rewrites the foldr/mapFB
-- thing back into plain map.
--
-- It's important that these two rules aren't both active at once
-- (along with build's unfolding) else we'd get an infinite loop
-- in the rules. Hence the activation control below.
--
-- The "mapFB" rule optimises compositions of map.
--
-- This same pattern is followed by many other functions:
-- e.g. append, filter, iterate, repeat, etc.
{-# RULES
"map" forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f
"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
"mapList" forall f. foldr (mapFB (:) f) [] = mapList f
#-}
\end{code}
......@@ -328,16 +345,13 @@ mapList f (x:xs) = f x : mapList f xs
----------------------------------------------
\begin{code}
(++) :: [a] -> [a] -> [a]
{-# NOINLINE [1] (++) #-}
(++) = append
(++) [] ys = ys
(++) (x:xs) ys = x : xs ++ ys
{-# RULES
"++" forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
#-}
append :: [a] -> [a] -> [a]
append [] ys = ys
append (x:xs) ys = x : append xs ys
\end{code}
......@@ -802,9 +816,9 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#)
ch -> unpack (C# ch : acc) (i# -# 1#)
{-# RULES